Search code examples
excelvbaimageoutlooksignature

Image in Sig Displays but Disappears when Sent via VBA


I have code that creates emails from Excel, and uses Ron DeBruin's method for adding the signature. It all works, and if I leave it as .display, the emails show up correctly, with the image. I had to modify the .htm file in the Outlook signature location to the full address of the image to make that work, which I learned here as well.

However, once I change the code to .send, the recipients are saying the images are blank...there is a spot for them, but they are blank boxes. If I set it to send to myself, the image arrives correctly. If I display the email first and THEN send, the recipients get the image as well. It just does not work when sending directly from within the code.

What would cause that? Do you see an error in my code? I have read that using getinspector could help but I do not understand how to do that, or how to apply it here if that indeed is a fix.

Also, I am open to not having the image be in the signature. It could just be inserted somewhere in the email...maybe even just an attachment, though embedded in the email is much preferred.

Thank you.

Option Explicit

Sub NOTIFICATIONS()
   Dim OutApp As Object
   Dim OutMail As Object
   Dim strbody As String
   Dim strname As String
   Dim strname1 As String
   Dim strname2 As String
   Dim strEmp As String
   Dim previousName As String
   Dim nextName As String
   Dim emailWS As Worksheet
   Dim nameCol As Double
   Dim nameCol2 As Double
   Dim empCol As Double
   Dim lastCol As Double
   Dim lastRow As Double
   Dim startRow As Double
   Dim startCol As Double
   Dim r As Double
   Dim sigstring As String
   Dim Signature As String
   Dim empList As String
   ' Get work signature
   sigstring = Environ("appdata") & "\Microsoft\Signatures\Notifications.htm"
   
   If Dir(sigstring) <> "" Then
      Signature = GetBoiler(sigstring)
   Else
      Signature = ""
   End If
   
   Set OutApp = CreateObject("Outlook.Application")
   Set emailWS = ActiveSheet
   startRow = 2
   startCol = 1
   nameCol = 3
   nameCol2 = 1
   empCol = 5
   lastRow = emailWS.Cells(emailWS.rows.Count, nameCol).End(xlUp).row
   lastCol = emailWS.Cells(1, emailWS.Columns.Count).End(xlToLeft).Column
   
   For r = startRow To lastRow
      strname = (emailWS.Cells(r, nameCol2))
      strname1 = Trim(Split(emailWS.Cells(r, nameCol2), ",")(1))
      strEmp = emailWS.Cells(r, empCol)
      If emailWS.Cells(r + 1, nameCol2) <> "" Then
         nextName = (emailWS.Cells(r + 1, nameCol2))
      Else
         nextName = "Exit"
      End If
      
      If strname <> previousName Then
         previousName = strname
         Set OutMail = OutApp.CreateItem(0)
         With OutMail
            .To = emailWS.Cells(r, 2).value
            .Subject = "Please Review Updated Information "
            empList = strEmp & "<br>"
            strbody = "<Font Face=calibri>Dear " & strname1 & ", <br><br> " & _
            "Please review the below."
         End With
      Else
         If InStr(empList, strEmp) = 0 Then
            empList = empList & strEmp & "<br>"
         End If
      End If
      
      If strname <> nextName Then
         OutMail.HTMLBody = strbody & "<B>" & empList & "</B>" & "<br>" & Signature
         OutMail.send
      End If
      
      If emailWS.Cells(r + 1, nameCol2) = "" Then
         Exit Sub
      End If
   Next r
   
   Set OutMail = Nothing
   Set OutApp = Nothing
End Sub

Function GetBoiler(ByVal sFile As String) As String
   Dim fso As Object
   Dim ts As Object
   Set fso = CreateObject("Scripting.FileSystemObject")
   Set ts = fso.GetFile(sFile).OpenAsTextStream(1, -2)
   GetBoiler = ts.ReadAll
   ts.Close
End Function

Solution

  • The local signature HTML refers to the local images. It is your responsibility to either make sure the images it refers to are on a web server (so that links do not need to be adjusted) or that you add images as attachments and modify the HTML to refer to the attached images (through cid in the img tag).

    See https://stackoverflow.com/a/71728029/332059