Çözüldü Outlook'u excel'den açarken resim eklemek

[muratgunay48]

Arkadaşlar, sayın hocalarım, biliyorum bu konuda çok soru sordum. Ama inanın benim için çok önemli. @Korhan Ayhan hocamın verdiği, çok iyi ve kullanışlı bir kod.

Sub mail()
'updated by Extendoffice 20190815
Dim xOtl As Object
Dim xOtlMail As Object
Dim xStrBody As String
tmp = CreateObject("Scripting.FileSystemObject").GetSpecialFolder(2) & "C:\Users\muratgunay48\Desktop\aaa\pic.JPEG"
xStrBody = "<font face='Calibri' size='4' color='black' weight='bold'>MERHABA</font>" & "<br>" & Chr(10) & _
"<font face='Calibri' size='4' color='blue' weight='bold'><a href=" & "a href=" & "https://www.excel.web.tr/"">TIKLAYINIZ</a></font>" & "<br>" & Chr(10) & _
"<font face='Calibri' size='4' color='black' weight='bold'>TEŞEKKÜRLER</font>"
    On Error Resume Next
    Set xOtl = CreateObject("Outlook.Application")
    Set xOtlMail = xOtl.CreateItem(olMailItem)
    With xOtlMail
        .To = "muratgunay48@gmail.com"
        .CC = "muratgunay48@gmail.com" & " ; " & "muratgunay48@gmail.com"
        '.BCC = " Email Address "
        .Subject = Format(Now, "dd.mm.yyyy hh.mm.ss")
        .HTMLBody = .HTMLBody & xStrBody
        .Display
    End With
    Set xOtl = Nothing
    Set xOtlMail = Nothing
End Sub

En başta bir logo koymam gerek,

koda nasıl bir ekleme yapabilirim



Kırmızı bölgeye resim koymam lazım. Mesela masaüstünde klasörde fotoğraflar olsa.



Şimdiden teşekkür ederim.

Saygılarımla.

 

[bmutlu966]

E1 hücresine resmin yolunu, F1 hücresine de resmin ismini yazarak deneyin.

Örneğin;

E1 e C:\Users\muratgunay48\Desktop\aaa\
F1 e pic.JPEG

Sub mail()
'updated by Extendoffice 20190815
Dim xOtl As Object
Dim xOtlMail As Object
Dim xStrBody As String
tmp = CreateObject("Scripting.FileSystemObject").GetSpecialFolder(2) & "C:\Users\muratgunay48\Desktop\aaa\pic.JPEG"
xStrBody = "<img src=cid:" & [F1] & "<br>" & "<font face='Calibri' size='4' color='black' weight='bold'>MERHABA</font>" & "<br>" & Chr(10) & _
"<font face='Calibri' size='4' color='blue' weight='bold'><a href=" & "a href=" & "https://www.excel.web.tr/"">TIKLAYINIZ</a></font>" & "<br>" & Chr(10) & _
"<font face='Calibri' size='4' color='black' weight='bold'>TEŞEKKÜRLER</font>"
    On Error Resume Next
    Set xOtl = CreateObject("Outlook.Application")
    Set xOtlMail = xOtl.CreateItem(olMailItem)
    With xOtlMail
        .To = "muratgunay48@gmail.com"
        .CC = "muratgunay48@gmail.com" & " ; " & "muratgunay48@gmail.com"
        '.BCC = " Email Address "
        .Subject = Format(Now, "dd.mm.yyyy hh.mm.ss")
        .Attachments.Add [E1] & [F1]
        .HTMLBody = .HTMLBody & xStrBody
        .Display
    End With
    Set xOtl = Nothing
    Set xOtlMail = Nothing
End Sub

 

[muratgunay48]

E1 hücresine resmin yolunu, F1 hücresine de resmin ismini yazarak deneyin.

Örneğin;

E1 e C:\Users\muratgunay48\Desktop\aaa\
F1 e pic.JPEG

Sub mail()
'updated by Extendoffice 20190815
Dim xOtl As Object
Dim xOtlMail As Object
Dim xStrBody As String
tmp = CreateObject("Scripting.FileSystemObject").GetSpecialFolder(2) & "C:\Users\muratgunay48\Desktop\aaa\pic.JPEG"
xStrBody = "<img src=cid:" & [F1] & "<br>" & "<font face='Calibri' size='4' color='black' weight='bold'>MERHABA</font>" & "<br>" & Chr(10) & _
"<font face='Calibri' size='4' color='blue' weight='bold'><a href=" & "a href=" & "https://www.excel.web.tr/"">TIKLAYINIZ</a></font>" & "<br>" & Chr(10) & _
"<font face='Calibri' size='4' color='black' weight='bold'>TEŞEKKÜRLER</font>"
    On Error Resume Next
    Set xOtl = CreateObject("Outlook.Application")
    Set xOtlMail = xOtl.CreateItem(olMailItem)
    With xOtlMail
        .To = "muratgunay48@gmail.com"
        .CC = "muratgunay48@gmail.com" & " ; " & "muratgunay48@gmail.com"
        '.BCC = " Email Address "
        .Subject = Format(Now, "dd.mm.yyyy hh.mm.ss")
        .Attachments.Add [E1] & [F1]
        .HTMLBody = .HTMLBody & xStrBody
        .Display
    End With
    Set xOtl = Nothing
    Set xOtlMail = Nothing
End Sub

Çok teşekkür ederim ?