VBA Outlook Email with Signature

[labonisimo]

Hi there,

I am using an excel template to send emails from excel. It all works fine but does not add my standard signature to it. I tweaked it a little, however doesnt do what it should do. It now adds my signature but not correctly (doesnt show images and shows hyperlinks.

Maybe you can help me fix it.

Option Explicit

Sub Send_Mails()
Dim emailMail As Object, signature As String
Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("Send_Mails")
Dim i As Integer

Dim OA As Object
Dim msg As Object

Set OA = CreateObject("outlook.application")
Set emailMail = OA.CreateItem(0)

Dim last_row As Integer
last_row = Application.CountA(sh.Range("A:A"))

For i = 2 To last_row
With emailMail
.Display
End With
signature = emailMail.Body

    Set msg = OA.CreateItem(0)
    msg.To = sh.Range("A" & i).Value
    msg.cc = sh.Range("B" & i).Value
    msg.Subject = sh.Range("C" & i).Value
    msg.Body = sh.Range("D" & i).Value & signature
    
    
    
    If sh.Range("E" & i).Value <> "" Then
        msg.attachments.Add sh.Range("E" & i).Value
    End If
    
    msg.send
    
    sh.Range("F" & i).Value = "Sent"

Next i

MsgBox "An alle Mitarbeiter verschickt"


End Sub

 

[gordsky]

Hi there,

I am using an excel template to send emails from excel. It all works fine but does not add my standard signature to it. I tweaked it a little, however doesnt do what it should do. It now adds my signature but not correctly (doesnt show images and shows hyperlinks.

Maybe you can help me fix it.

Option Explicit

Sub Send_Mails()
Dim emailMail As Object, signature As String
Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("Send_Mails")
Dim i As Integer

Dim OA As Object
Dim msg As Object

Set OA = CreateObject("outlook.application")
Set emailMail = OA.CreateItem(0)

Dim last_row As Integer
last_row = Application.CountA(sh.Range("A:A"))

For i = 2 To last_row
With emailMail
.Display
End With
signature = emailMail.Body

    Set msg = OA.CreateItem(0)
    msg.To = sh.Range("A" & i).Value
    msg.cc = sh.Range("B" & i).Value
    msg.Subject = sh.Range("C" & i).Value
    msg.Body = sh.Range("D" & i).Value & signature
   
   
   
    If sh.Range("E" & i).Value <> "" Then
        msg.attachments.Add sh.Range("E" & i).Value
    End If
   
    msg.send
   
    sh.Range("F" & i).Value = "Sent"

Next i

MsgBox "An alle Mitarbeiter verschickt"


End Sub

have you tried changing your .body statements to .htmlbody

 

[labonisimo]

have you tried changing your .body statements to .htmlbody

Thank you. Already a big hint. It does not show it formatted correctly. Only problem, it doesn show images and icons.

 

[gordsky]

Thank you. Already a big hint. It does not show it formatted correctly. Only problem, it doesn show images and icons.

are you able to attach an image of how it looks and how you would expect it toll if not doing theough vba

 

[labonisimo]

are you able to attach an image of how it looks and how you would expect it toll if not doing theough vba

It basically saying that the linked image cannot be shown.

 

[Amir Wisal]

Hi There,

Its a bit old thread but posting it anyway. I am fairly new to VBA but faced the same issue a couple of months ago.

I have updated your code as follows (below part only) and it works fine for me. now pick the default signature with links and proper images.

Set OA = CreateObject("outlook.application")
Set emailMail = OA.CreateItem(0)

For i = 2 To last_row

Set msg = OA.CreateItem(0)

With msg
.To = sh.Range("A" & i).Value
.CC = sh.Range("B" & i).Value
.Subject = sh.Range("C" & i).Value
.Display
.HTMLBody = sh.Range("D" & i).Value _
& .HTMLBody

End With