Include signature with image AND image in an email

I have been trying to get a function to work that will enable me to pick up the default Outlook signature AND include an image in the email without success. Using the code below the email looks correct when it's sent but the attachment has an "image cannot be displayed" message in place of the attachment, however it has the full default signature including the image.

Is there any way of including both?

Function OutlookEmail(Message As String _
                , EmailAddress As String _
                , Subject As String _
                , EditBeforeSending As Boolean _
                , Optional AttachmentPath As Variant _
                , Optional CC As String _
                , Optional BCC As String _
                , Optional EmbedImage As Boolean _
                )

    Dim objOutlook As Object
    Dim sBody As String
    Dim ssignature As String
    Dim AttachmentName As String
    Dim i As Integer
   
    On Error GoTo OutlookEmail_Error

    Set objOutlook = GetObject(, "Outlook.Application") ' Determine if Outlook is open
   
    If Err <> 0 And Err <> -2147221238 Then
        'try one more time after a short wait
        Sleep 1000
        Set objOutlook = GetObject(, "Outlook.Application") ' Determine if Outlook is open
    End If
   
    If Err <> 0 And Err <> -2147221238 Then
        Speak "Uh, Oh"
        MsgBox "You need to open 'Outlook' in order to send email.", vbInformation, "Outlook Not Open Alert"
        Set objOutlook = Nothing
        Exit Function
    End If
   
   
    Dim objMailItem As Object
    Const olMailItem As Integer = 0
    Set objMailItem = objOutlook.CreateItem(olMailItem)
    objMailItem.display
   
    'ssignature = objMailItem.HTMLBody
   
    sBody = "<font face=Arial>" & Message & "</font>"
   
    With objMailItem
        .To = EmailAddress
     
        If Not IsMissing(CC) Then
            .CC = CC
        End If
     
        If Not IsMissing(BCC) Then
            .BCC = BCC
        End If
     
        .Subject = Subject
     
        ' Add attachments to the message.
        If Not IsMissing(AttachmentPath) Then
            If IsArray(AttachmentPath) Then
                For i = LBound(AttachmentPath) To UBound(AttachmentPath)
                    If AttachmentPath(i) <> "" And AttachmentPath(i) <> "False" Then
                        .Attachments.Add AttachmentPath(i) ', 1, 0
                        'only display if there is one attachment
                    End If
                Next i
                .htmlbody = sBody & "<br>" & .htmlbody
            Else
                If AttachmentPath <> "" And AttachmentPath <> "False" Then
                    .Attachments.Add AttachmentPath ', 1, 0
                   
                    'Insert the attachment in the body if required
                    If Right(AttachmentPath, 4) = ".jpg" _
                      Or Right(AttachmentPath, 4) = ".png" _
                      And EmbedImage = True Then
                   
                        AttachmentName = Mid(AttachmentPath, InStrRev(AttachmentPath, "\") + 1)
                        .htmlbody = sBody & HTMLNEWLINE & HTMLNEWLINE & "<img src='cid:" & AttachmentName _
                          & "' align=baseline border=0 >" & .htmlbody
                    Else
                        .htmlbody = sBody & "<br>" & .htmlbody
                    End If
                End If
            End If
        Else
            .htmlbody = sBody & "<br>" & .htmlbody
        End If
     
     
        If EditBeforeSending = True Then
'              .display (EditBeforeSending) ' true makes outlook modal
        Else
            .send
        End If
    End With

OutlookEmail_Exit:
    Set objOutlook = Nothing
    Set objMailItem = Nothing
   

   On Error GoTo 0
   Exit Function

OutlookEmail_Error:

    MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure OutlookEmail of Module ModEmailFunctions"
    Resume OutlookEmail_Exit
    Resume
End Function
Rob4077Asked:
Who is Participating?
 
Jeff DarlingDeveloper AnalystCommented:
You can embed images into the HTML like this.

Option Compare Database

Public Function CreateHTMLEmail()

    Dim strHTML
    
    strHTML = "<!DOCTYPE HTML>"
    strHTML = strHTML & "<html>"
    strHTML = strHTML & "<head>"
    strHTML = strHTML & "<meta name=" & Chr(34) & "ProgId" & Chr(34) & "content=" & Chr(34) & "Word.Document" & Chr(34) & ">"
    strHTML = strHTML & "</head>"
    strHTML = strHTML & "<body>"
    strHTML = strHTML & "<table>"
    strHTML = strHTML & "<tr>"
    strHTML = strHTML & "<td><img alt=" & Chr(34) & Chr(34) & " src=" & Chr(34) & "cid:image1.jpg" & Chr(34) & "/></td>"
    strHTML = strHTML & "<td><img alt=" & Chr(34) & Chr(34) & " src=" & Chr(34) & "cid:image2.jpg" & Chr(34) & "/></td>"
    strHTML = strHTML & "</tr>"
    strHTML = strHTML & "</table>"
    strHTML = strHTML & "</body></html>"
    
    
    
    Const CdoReferenceTypeName = 1
    Dim objCDO, objBP
    
    Set objCDO = CreateObject("CDO.Message")
    objCDO.Subject = "test email"
    objCDO.From = """Jeff Darling"" <jeff@foo.com>"
    
    objCDO.To = "jeff@foo.com"
    objCDO.HTMLBody = strHTML
    objCDO.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
    objCDO.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "muncasarray1.medline.com"
    objCDO.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
    objCDO.Configuration.Fields.Update
    objCDO.MimeFormatted = True
    

    ' Embed Image
    Set objBP = objCDO.AddRelatedBodyPart("c:\work\image1.jpg", "image1.jpg", CdoReferenceTypeName)
    objBP.Fields.Item("urn:schemas:mailheader:Content-ID") = "<image1.jpg>"
    objBP.Fields.Update
    
    ' Embed Image
    Set objBP = objCDO.AddRelatedBodyPart("c:\work\image2.jpg", "image2.jpg", CdoReferenceTypeName)
    objBP.Fields.Item("urn:schemas:mailheader:Content-ID") = "<image2.jpg>"
    objBP.Fields.Update
    
    
    objCDO.Send
    Set objCDO = Nothing

End Function

Open in new window

0
 
Rob4077Author Commented:
Hi Jeff, and thanks for your suggestion. I have used the CDO object library before but from what I recall it has a few limitations. First is that it doesn't save the messages in the Outlook sent folder and secondly I can't recall if I ever figured out how to configure it to send it using Microsoft Exchange. Am I right?
0
 
Jeff DarlingDeveloper AnalystCommented:
Your code using Outlook works for me.  If I specify these parameters to the call:

OutlookEmail("test message","jdarling@foo.com, "test subject", True, "c:\work\image1.jpg", , , True) 

Open in new window


I get both the signature and the image.  You are already using cid in the HTML.
0
Keep up with what's happening at Experts Exchange!

Sign up to receive Decoded, a new monthly digest with product updates, feature release info, continuing education opportunities, and more.

 
Rob4077Author Commented:
Does it work when you send it to a different email address to the sending email address? I am puzzled.
0
 
Jeff DarlingDeveloper AnalystCommented:
It does not matter what recipient I choose.  It works the same.

I tried sending to a gmail account and it sent the message and the image was included as an attachment and not in the body.
0
 
Rob4077Author Commented:
Well Jeff, I remain totally confused. I tried running this from my laptop at home on the weekend, using my yahoo account to send the email to a gmail account and it worked perfectly. But when I run exactly the same code from my work PC which uses a MS Exchange email account I get the image in the signature but the one in the email body has been removed.
0
 
Rob4077Author Commented:
Hi Jeff, I tried using this line instead and it works perfectly. Is there any reason I shouldn't use this given it appears to work?
.HTMLBody = .HTMLBody & HTMLNEWLINE & HTMLNEWLINE & "<IMG src=" & AttachmentPath & "" & " align=baseline border=0>"
0
 
Rob4077Author Commented:
Please award all the points to Jeff.
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.