Solved

Include signature with image AND image in an email

Posted on 2016-09-07
9
31 Views
Last Modified: 2016-10-25
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
0
Comment
Question by:Rob4077
  • 5
  • 3
9 Comments
 
LVL 12

Accepted Solution

by:
Jeff Darling earned 500 total points
ID: 41787984
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
 

Author Comment

by:Rob4077
ID: 41788846
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
 
LVL 12

Expert Comment

by:Jeff Darling
ID: 41790144
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
U.S. Department of Agriculture and Acronis Access

With the new era of mobile computing, smartphones and tablets, wireless communications and cloud services, the USDA sought to take advantage of a mobilized workforce and the blurring lines between personal and corporate computing resources.

 

Author Comment

by:Rob4077
ID: 41790555
Does it work when you send it to a different email address to the sending email address? I am puzzled.
0
 
LVL 12

Expert Comment

by:Jeff Darling
ID: 41791262
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
 

Author Comment

by:Rob4077
ID: 41793725
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
 

Assisted Solution

by:Rob4077
Rob4077 earned 0 total points
ID: 41795589
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
 

Author Comment

by:Rob4077
ID: 41851999
Please award all the points to Jeff.
0

Featured Post

Free Tool: ZipGrep

ZipGrep is a utility that can list and search zip (.war, .ear, .jar, etc) archives for text patterns, without the need to extract the archive's contents.

One of a set of tools we're offering as a way to say thank you for being a part of the community.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Overview: This article:       (a) explains one principle method to cross-reference invoice items in Quickbooks®       (b) explores the reasons one might need to cross-reference invoice items       (c) provides a sample process for creating a M…
Describes a method of obtaining an object variable to an already running instance of Microsoft Access so that it can be controlled via automation.
In Microsoft Access, learn how to “cascade” or have the displayed data of one combo control depend upon what’s entered in another. Base the dependent combo on a query for its row source: Add a reference to the first combo on the form as criteria i…
With Microsoft Access, learn how to start a database in different ways and produce different start-up actions allowing you to use a single database to perform multiple tasks. Specify a start-up form through options: Specify an Autoexec macro: Us…

820 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question