Solved

Include signature with image AND image in an email

Posted on 2016-09-07
9
23 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
 

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
How your wiki can always stay up-to-date

Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
- Increase transparency
- Onboard new hires faster
- Access from mobile/offline

 
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

How your wiki can always stay up-to-date

Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
- Increase transparency
- Onboard new hires faster
- Access from mobile/offline

Join & Write a Comment

It took me quite some time to sort out all the different properties of combo and list boxes available from Visual Basic at run-time. Not that the documentation is lacking: the help pages are quite thorough and well written. The problem was rather wh…
In a multiple monitor setup, if you don't want to use AutoCenter to position your popup forms, you have a problem: where will they appear?  Sometimes you may have an additional problem: where the devil did they go?  If you last had a popup form open…
Get people started with the utilization of class modules. Class modules can be a powerful tool in Microsoft Access. They allow you to create self-contained objects that encapsulate functionality. They can easily hide the complexity of a process from…
In Microsoft Access, learn different ways of passing a string value within a string argument. Also learn what a “Type Mis-match” error is about.

705 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

Need Help in Real-Time?

Connect with top rated Experts

18 Experts available now in Live!

Get 1:1 Help Now