Excel ile Email gönderim Hk.da

[ufukufuk01]

Merhabalar

Forumda aşağıdaki gibi bir email kodu buldum. Başka bir excel dosyamda oluşturmuş olduğum (Makro ile) uzantısı html olarak oluşturduğum bir dosyam var. Aşağıdaki e-mail gönder komutunu kullandığım zaman sorunsuz gidiyor. Fakat ben dosyayı ekle olarak değilde metin olarak ekle olarak yapıp göndermek istiyorum. aşağıdaki kod için hangi değişikliği yapmam gerekiyor. Şimdiden yardımlarınız için tşk.ler
(.Attachments.Add )




Sub e-mail_gönder()
Dim OutlookUygulama As Object
Dim mail As Object

Set OutlookUygulama = New Outlook.Application
Set mail = OutlookUygulama.CreateItem(0)

With mail
.To = "kimegidecek@kime.com.tr"
.CC = "İsteğe bağlı"
.BCC = "İsteğe bağlı"
.Subject = "Konu"
.Body = "Mesaj"
.Attachments.Add ("D:\Belgelerim\Desktop\deneme.html")
.Display
'.Send
End With

Set mail = Nothing
Set OutlookUygulama = Nothing
End Sub

 

[PLİNT]

Merhaba
Yanlış anlamadıysam, mesaj kısmına yazmak için aşağıdaki gibi deneyiniz

Option Explicit
Function kls(ByVal dosy As String) As String
    Dim fs As Object
    Dim ts As Object
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set ts = fs.GetFile(dosy).OpenAsTextStream(1, -2)
    kls = ts.readall
    ts.Close
End Function
Sub e-mail_gönder()
    Dim OutlookUygulama  As Object
    Dim mail As Object
    Dim dsy, ktp As String
If ktp = Empty Then
    dsy = "D:\Belgelerim\Desktop\deneme.html"
    If Dir(dsy) <> "" Then
        ktp = kls(dsy)
    Else
        ktp = ""
    End If
End If
'Set OutlookUygulama = New Outlook.Application
Set OutlookUygulama = CreateObject("Outlook.Application")
Set mail = OutlookUygulama.CreateItem(0)

With mail
.To = "kimegidecek@kime.com.tr"
.CC = "İsteğe bağlı"
.BCC = "İsteğe bağlı"
.Subject = "Konu"
.BodyFormat = 2
.HTMLBody = ktp
'.Body = "Mesaj"
'.Attachments.Add ("D:\Belgelerim\Desktop\deneme.html")
.Display
'.Send
End With

Set mail = Nothing
Set OutlookUygulama = Nothing
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[ufukufuk01]

Merhaba
Yanlış anlamadıysam, mesaj kısmına yazmak için aşağıdaki gibi deneyiniz

Option Explicit
Function kls(ByVal dosy As String) As String
    Dim fs As Object
    Dim ts As Object
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set ts = fs.GetFile(dosy).OpenAsTextStream(1, -2)
    kls = ts.readall
    ts.Close
End Function
Sub e-mail_gönder()
    Dim OutlookUygulama  As Object
    Dim mail As Object
    Dim dsy, ktp As String
If ktp = Empty Then
    dsy = "D:\Belgelerim\Desktop\deneme.html"
    If Dir(dsy) <> "" Then
        ktp = kls(dsy)
    Else
        ktp = ""
    End If
End If
'Set OutlookUygulama = New Outlook.Application
Set OutlookUygulama = CreateObject("Outlook.Application")
Set mail = OutlookUygulama.CreateItem(0)

With mail
.To = "kimegidecek@kime.com.tr"
.CC = "İsteğe bağlı"
.BCC = "İsteğe bağlı"
.Subject = "Konu"
.BodyFormat = 2
.HTMLBody = ktp
'.Body = "Mesaj"
'.Attachments.Add ("D:\Belgelerim\Desktop\deneme.html")
.Display
'.Send
End With

Set mail = Nothing
Set OutlookUygulama = Nothing
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

Çok teşekkür ederim aradığım fonksiyon buydu. Tşk.ler