AccessTr.neT

Ekledim dosyayı.

benim gönderdiğim dosyada "modül3" vardı, "rangetohtml()" fonksiyonu orada tanımlıydı. "Modul3" silinmiş

---

ama  eğer tek hücre ekleyecekseniz yani sadece "K" yı o zaman modüle falan gerek yok doğrudan 
kodu aşağıdaki gibi yapın

Sub MailActiveSheet()



Dim FileExtStr As String

Dim FileFormatNum As Long

Dim Sourcewb As Workbook

Dim Destwb As Workbook

Dim TempFilePath As String

Dim TempFileName As String

Dim OutApp As Object

Dim OutMail As Object

Dim i As Integer

Dim rng As Range

Set rng = Nothing



i = ActiveCell.Row '<======== i= seçtiğimiz satırı gösterir satırdaki herhangi bir hücreye basılabilir

        

With Application

    .ScreenUpdating = False

    .EnableEvents = False

End With





Set OutApp = CreateObject("Outlook.Application")

Set OutMail = OutApp.CreateItem(0)





    On Error Resume Next

    With OutMail

        .to = ""

        .CC = ""

        .BCC = ""

        .Subject = "IT WORK ORDER"

                .Body = "Sayın İlgililer:" & vbNewLine & _

                    "IT Departmanı ile ilgili yeni oluşturulan iş emrini aşağıda görebilirsiniz." & _

                     vbNewLine & "İyi Çalışmalar" & vbNewLine & vbNewLine & _

                     Range("K" & i).Value

        '.Attachments.Add Destwb.FullName

        '.Send

        .Display

    End With

    On Error GoTo 0



Set OutMail = Nothing

Set OutApp = Nothing



With Application

    .ScreenUpdating = True

    .EnableEvents = True

End With

End Sub

(11/05/2019, 02:16)haliliyas yazdı: [ -> ]ama  eğer tek hücre ekleyecekseniz yani sadece "K" yı o zaman modüle falan gerek yok doğrudan 
kodu aşağıdaki gibi yapın

Sub MailActiveSheet()



Dim FileExtStr As String

Dim FileFormatNum As Long

Dim Sourcewb As Workbook

Dim Destwb As Workbook

Dim TempFilePath As String

Dim TempFileName As String

Dim OutApp As Object

Dim OutMail As Object

Dim i As Integer

Dim rng As Range

Set rng = Nothing



i = ActiveCell.Row '<======== i= seçtiğimiz satırı gösterir satırdaki herhangi bir hücreye basılabilir

        

With Application

    .ScreenUpdating = False

    .EnableEvents = False

End With





Set OutApp = CreateObject("Outlook.Application")

Set OutMail = OutApp.CreateItem(0)





    On Error Resume Next

    With OutMail

        .to = ""

        .CC = ""

        .BCC = ""

        .Subject = "IT WORK ORDER"

                .Body = "Sayın İlgililer:" & vbNewLine & _

                    "IT Departmanı ile ilgili yeni oluşturulan iş emrini aşağıda görebilirsiniz." & _

                     vbNewLine & "İyi Çalışmalar" & vbNewLine & vbNewLine & _

                     Range("K" & i).Value

        '.Attachments.Add Destwb.FullName

        '.Send

        .Display

    End With

    On Error GoTo 0



Set OutMail = Nothing

Set OutApp = Nothing



With Application

    .ScreenUpdating = True

    .EnableEvents = True

End With

End Sub

Tamam Hocam sehven silmişim Modül 3 ü. Ama dediğiniz gibi sadece K'yı ekleyeceğim. En son gönderdiğiniz kodlamayı kullandım. Çalıştı.

Emeğinize sağlık. Teşekkür ederim.

Saygılarımla