Still celebrating National IT Professionals Day with 3 months of free Premium Membership. Use Code ITDAY17

x
?
Solved

Include signature with image AND image in an email

Posted on 2016-09-07
9
Medium Priority
?
41 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 2000 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
 [eBook] Windows Nano Server

Download this FREE eBook and learn all you need to get started with Windows Nano Server, including deployment options, remote management
and troubleshooting tips and tricks

 

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

Windows Server 2016: All you need to know

Learn about Hyper-V features that increase functionality and usability of Microsoft Windows Server 2016. Also, throughout this eBook, you’ll find some basic PowerShell examples that will help you leverage the scripts in your environments!

Question has a verified solution.

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

As tax season makes its return, so does the increase in cyber crime and tax refund phishing that comes with it
This article describes a method of delivering Word templates for use in merging Access data to Word documents, that requires no computer knowledge on the part of the recipient -- the templates are saved in table fields, and are extracted and install…
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…
Access reports are powerful and flexible. Learn how to create a query and then a grouped report using the wizard. Modify the report design after the wizard is done to make it look better. There will be another video to explain how to put the final p…

715 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