Solved

Include signature with image AND image in an email

Posted on 2016-09-07
9
40 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
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 5
  • 3
9 Comments
 
LVL 13

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 13

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
Online Training Solution

Drastically shorten your training time with WalkMe's advanced online training solution that Guides your trainees to action. Forget about retraining and skyrocket knowledge retention rates.

 

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 13

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

PeopleSoft Has Never Been Easier

PeopleSoft Adoption Made Smooth & Simple!

On-The-Job Training Is made Intuitive & Easy With WalkMe's On-Screen Guidance Tool.  Claim Your Free WalkMe Account Now

Question has a verified solution.

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

Phishing attempts can come in all forms, shapes and sizes. No matter how familiar you think you are with them, always remember to take extra precaution when opening an email with attachments or links.
Did you know that more than 4 billion data records have been recorded as lost or stolen since 2013? It was a staggering number brought to our attention during last week’s ManageEngine webinar, where attendees received a comprehensive look at the ma…
Familiarize people with the process of retrieving data from SQL Server using an Access pass-thru query. Microsoft Access is a very powerful client/server development tool. One of the ways that you can retrieve data from a SQL Server is by using a pa…
Learn how to number pages in an Access report over each group. Activate two pass printing by referencing the pages property: Add code to the Page Footers OnFormat event to capture the pages as there occur for each group. Use the pages property to …

624 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