Embedding images in Outlook 2010 with VBA

**JasonCollier** · 01-29-2015, 01:39 AM

Hi all,

I'm new to coding and am trying to automate sending emails from my access database. I've set up a module that sends out a HTML formatted email which works great, except the images don't show up in the recipients email - the images are included as attachments and where they are supposed to be in the email there are broken image icons.

I have searched for help on embedding images in Outlook, but have had no luck getting it to work. Can anyone show me how to fix my code below so that it will embed images instead of attaching them?

Many thanks!
Jason

Option Compare Database


Option Explicit


Sub SendMessages(Optional AttachmentPath)


  Dim MyDB As Database
  Dim MyRS As Recordset
  Dim objOutlook As Outlook.Application
  Dim objOutlookMsg As Outlook.MailItem
  Dim objOutlookRecip As Outlook.Recipient
  Dim objOutlookAttach As Outlook.Attachments
  Dim myAttach As Outlook.Attachment
  Dim TheAddress As String


  Set MyDB = CurrentDb
  Set MyRS = MyDB.OpenRecordset("qry_Members")
  MyRS.MoveFirst
  
  ' Create the Outlook session.
  Set objOutlook = CreateObject("Outlook.Application")
   
  Do Until MyRS.EOF
  ' Create the e-mail message.
  Set objOutlookMsg = objOutlook.CreateItem(olMailItem)
  TheAddress = MyRS![WorkEmail]
  
     With objOutlookMsg
        ' Add the To recipients to the e-mail message.
        Set objOutlookRecip = .Recipients.Add(TheAddress)
        objOutlookRecip.Type = olTo
        
        ' Add the CC recipients
        Set objOutlookRecip = .Recipients.Add("email address")
        objOutlookRecip.Type = olCC
        
        ' Set the from address.
        objOutlookMsg.SentOnBehalfOfName = "email address"
  
        ' Set the Subject, the Body, and the Importance of the e-mail message.
        .Subject = "subject"
               
        Set objOutlookAttach = objOutlookMsg.Attachments
        Set myAttach = objOutlookAttach.Add("C:\Users\collj\Desktop\database\sig.jpg", olByValue, 0)
        Set myAttach = objOutlookAttach.Add("C:\Users\collj\Desktop\database\banner.jpg", olByValue, 0)
        objOutlookMsg.Close olSave
        objOutlookMsg.Save
        
        objOutlookMsg.BodyFormat = olFormatHTML
        
        
        .HTMLBody = "<html><body>"


        .HTMLBody = .HTMLBody & "<table align=""center"" style=""width:580px; margin:0 auto; padding:0; border:0"" cellspacing=""0"" cellpadding=""0"">"


        .HTMLBody = .HTMLBody & "<tr><td style=""background-color:#46819b; font-family:Arial,Sans-serif; font-size:12px; color:white; margin:0;padding:10px"">Title</td></tr>"


        .HTMLBody = .HTMLBody & "<tr><td><img src=""cid:banner.jpg""></td></tr><tr><td style=""padding:20px 10px"">"


        .HTMLBody = .HTMLBody & "<p style=""font-family:Arial,Sans-serif; font-size:12px; color:#666666"">Dear " & MyRS![FirstName] & ",</p>"
        
        .HTMLBody = .HTMLBody & "<p style=""font-family:Arial,Sans-serif; font-size:12px; color:#666666"">Content goes here</p>"


        .HTMLBody = .HTMLBody & "<p style=""font-family:Arial,Sans-serif; font-size:12px; color:#666666"">Yours sincerely,</p><p><img src=""cid:sig.jpg""></p>"


        .HTMLBody = .HTMLBody & "<p style=""font-family:Arial,Sans-serif; font-size:12px; color:#666666"">Name</p></td></tr>"


        .HTMLBody = .HTMLBody & "</table></body></html>"


        .Importance = olImportanceNormal 'Normal importance
        
        objOutlookMsg.Save
        
        ' Resolve the name of each Recipient.
        For Each objOutlookRecip In .Recipients
           objOutlookRecip.Resolve
           If Not objOutlookRecip.Resolve Then
             objOutlookMsg.Display
           End If
        Next
        .Send
      End With
      MyRS.MoveNext
   Loop
   Set objOutlookMsg = Nothing
   Set objOutlook = Nothing
End Sub

**gmayor** · 01-29-2015, 02:50 AM

I don't work in Access, but the business of creating e-mails using Outlook is pretty similar across the Office products, so if I was doing this I would be inclined to use the Outlook Inspector to edit the message body directly. It is then very similar to working in Word e.g.

Public Sub CreateEmail()
Dim olApp As Object
Dim olMail As Object        ' Outlook.MailItem
Dim olInspector As Object        ' Outlook.Inspector
Dim olAttach As Object
Dim wdDoc As Object        ' Word.Document
Dim wdRange As Object        ' Word.Range

    On Error Resume Next
    Set olApp = GetObject(, "Outlook.Application")
    If olApp Is Nothing Then Set olApp = CreateObject("Outlook.Application")
    If olApp Is Nothing Then Exit Sub
    On Error GoTo 0

    Set olMail = olApp.CreateItem(0)

    With olMail
        .to = "someone@somewhere.com"
        .Subject = "This is the subject"
        Set olAttach = olMail.Attachments
        olAttach.Add "C:\Path\example.txt"
        Set olInspector = .GetInspector
        Set wdDoc = olInspector.WordEditor
        Set wdRange = wdDoc.Range(0, 0)
        wdRange.Text = "Dear Recipient" & vbCr & vbCr & _
                       "Message content" & vbCr & vbCr
        wdRange.Collapse 0
        wdRange.InlineShapes.AddPicture Filename:= _
                                        "C:\Path\Filename.jpg", _
                                        LinkToFile:=False, _
                                        SaveWithDocument:=True
        wdRange.End = wdRange.End + 2
        wdRange.Collapse 0
        wdRange.Text = vbCr & "Yours sincerely" & vbCr
        wdDoc.Range.Font.name = "Arial"
        wdDoc.Range.Font.Size = 12
        .Display ' This line is required.
        .Send
    End With
lbl_Exit:
    Exit Sub
End Sub

Thread: Embedding images in Outlook 2010 with VBA

Thread Tools

Display

Embedding images in Outlook 2010 with VBA

Tags for this Thread

Posting Permissions