0

I have a button on a form to send an email to an address in a textbox. The code works fine and sends the email correctly except for the embedded image. That does not show up. I tried the .AddAttachment with the cid: but that just displays the attachment and not the embedded image.

Dim NewMail As Object
Dim mailConfig As Object
Dim fields As Variant
Dim msConfigURL, TextBody1, TextBody2, StrBody As String

On Error GoTo Err:

'late binding
Set NewMail = CreateObject("CDO.Message")
Set mailConfig = CreateObject("CDO.Configuration")

' load all default configurations
mailConfig.Load -1

Set fields = mailConfig.fields

StrBody = "Hello " & TextBox2.Value & ", <p> " & _
            "Please verify your squad selection and average division,<br>" & _
            "And please reply with correct information if an error is found.<p>" & _
            "Squad: " & ComboBox1.Value & ", <br> " & _
            "Average: " & TextBox9.Value

'Set All Email Properties
With NewMail
enable_html = True
.From = "[email protected]"  'normally my email account
.To = TextBox7.Value
.CC = ""
.BCC = ""
.Subject = "40 Frame Game Tournament Confirmation  " & Format(Date, "m/d/yy")
.AddAttachment "C:\Users\bradb\OneDrive\Desktop\SWC-Signature.png", 1, 0
.HTMLBody = "<HTML><BODY style=font-size:18pt; font-family:Arial;>" & StrBody & _
"<img src='cid:SWC-Signature.png'" & "width='375'>" & _
"<p>Thank You<br>Brad Bylls<br>Tournament Manager</p></BODY></HTML>"

End With

msConfigURL = "http://schemas.microsoft.com/cdo/configuration"


With fields
    .Item(msConfigURL & "/smtpusessl") = True             'Enable SSL Authentication
    .Item(msConfigURL & "/smtpauthenticate") = 1          'SMTP authentication Enabled
    .Item(msConfigURL & "/smtpserver") = "smtp.gmail.com" 'Set the SMTP server details
    .Item(msConfigURL & "/smtpserverport") = 465          'Set the SMTP port Details
    .Item(msConfigURL & "/sendusing") = 2                 'Send using default setting
    .Item(msConfigURL & "/sendusername") = "[email protected]" 'Your gmail address
    .Item(msConfigURL & "/sendpassword") = "**** **** **** ****"
    .Update                                           'Update the configuration fields
End With
NewMail.Configuration = mailConfig
NewMail.Send
5
  • 1
    "I tried the .AddAttachment with the cid" - would be better to show that code and not the one you have posted, which will never work. Previously: stackoverflow.com/a/44870371/478884 Commented Apr 30 at 19:33
  • 1
    ...or base64-encode your image and use something like: "<img src='data:image/jpeg;base64," & imageData & "' width='300'>" where imageData is a string representing the encoded image file. For encoding see (eg) stackoverflow.com/a/41638989/478884 Commented Apr 30 at 19:37
  • Tim, Here is the other code: With NewMail enable_html = True .From = "[email protected]" 'normally my email account .To = TextBox7.Value .CC = "" .BCC = "" .Subject = "40 Frame Game Tournament Confirmation " & Format(Date, "m/d/yy") .Attachments.Add "C:\Users\bradb\OneDrive\Desktop\SWC-Signature.png", 1, 0 .HTMLBody = "<HTML><BODY style=font-size:18pt; font-family:Calibri;>" & StrBody & _ "<img src='cid:SWC-Signature.png'" & "width='375'>" & _ "<p>Thank You<br>Brad Bylls<br>Tournament Manager</p></BODY></HTML>" End With Commented May 1 at 17:33
  • You should edit your post (click the "Edit" link) and put the code there - it can't be read in a comment. If your image is just a signature then I would go with the second option of Base64-encoding the file and including it directly in the <img> tag. Commented May 1 at 17:44
  • Updated post. Sorry, I don't understand the base64 stuff. Commented May 1 at 21:21

1 Answer 1

1

This worked for me (updated to show how to add and display multiple images):

Sub Tester()
    Dim html As String, arrImageInfo
    
    'html for the email body
    html = "<html><body><p>This is a test mail using images.</p>" & _
       "<img src='cid:ID_0001'>" & _
       "<p>There should be an image above this text, and also below.</p>" & _
       "<img src='cid:ID_0002'></body></html>"
            
    'One path and one CID for each distinct image in `html`
    arrImageInfo = Array("C:\Temp\tempo.png", "ID_0001", _
                         "C:\Temp\sig.png", "ID_0002")
    
    SendEmailUsingGmail "[email protected]", "HTML Image Test", html, arrImageInfo
End Sub


Public Sub SendEmailUsingGmail(sRecipients As String, sSubject As String, html As String, _
                                Optional arrImageInfo As Variant = Empty)

    Const SEND_AS As String = "[email protected]"
    'See https://www.makeuseof.com/tag/send-emails-excel-vba/ for
    '      how to set up a password in GMail for CDO
    Const SEND_AS_PW As String = "xxxxxxxxxxxxxx"
    Const CONFIG_URL As String = "http://schemas.microsoft.com/cdo/configuration/"
    
    Dim NewMail As Object, mailConfig As Object, i As Long
    
    On Error GoTo Err:
    
    Set NewMail = CreateObject("CDO.Message")
    
    Set mailConfig = CreateObject("CDO.Configuration")
    mailConfig.Load -1 ' load all default configurations
    
    With mailConfig.fields
        .Item(CONFIG_URL & "smtpusettls") = False
        .Item(CONFIG_URL & "smtpusessl") = True             'Enable SSL Authentication
        .Item(CONFIG_URL & "smtpauthenticate") = 1          'SMTP authentication Enabled
        .Item(CONFIG_URL & "smtpserver") = "smtp.gmail.com" 'Set the SMTP server details
        .Item(CONFIG_URL & "smtpserverport") = 465          'Set the SMTP port Details
        .Item(CONFIG_URL & "sendusing") = 2                 'Send using default setting
        .Item(CONFIG_URL & "sendusername") = SEND_AS        'gmail address
        .Item(CONFIG_URL & "sendpassword") = SEND_AS_PW     'Your password or App Password
        .Update
    End With
    NewMail.Configuration = mailConfig
    
    'Any image CID's to add to the mail?
    If Not IsEmpty(arrImageInfo) Then
        For i = LBound(arrImageInfo) To UBound(arrImageInfo) Step 2
            'Add the image and set its CID
            AddBodyPartWithId NewMail, arrImageInfo(i), arrImageInfo(i + 1)
        Next i
    End If
    
    With NewMail
        .From = SEND_AS
        .To = sRecipients
        .CC = ""
        .BCC = ""
        .Subject = sSubject
        .HTMLBody = html
        .send
    End With
    MsgBox "Your email has been sent", vbInformation
    
Exit_Err:
        'Release object memory
        Set NewMail = Nothing
        Set mailConfig = Nothing
        Exit Sub
    
Err:
        Select Case Err.Number
        Case -2147220973  'Could be because of Internet Connection
            MsgBox "Check your internet connection." & vbNewLine & Err.Number & ": " & Err.Description
        Case -2147220975  'Incorrect credentials User ID or password
            MsgBox "Check your login credentials and try again." & vbNewLine & Err.Number & ": " & Err.Description '<- I'm getting to this error
        Case Else   'Report other errors
            MsgBox "Error encountered while sending email." & vbNewLine & Err.Number & ": " & Err.Description
        End Select
    
        Resume Exit_Err

End Sub

'Add an image to `msg` and set its CID
Sub AddBodyPartWithId(msg As Object, bodyPartPath, bodyPartCID)
    With msg.AddRelatedBodyPart(bodyPartPath, bodyPartCID, 0) '0=cdoRefTypeId
        .fields.Item("urn:schemas:mailheader:Content-ID") = bodyPartCID
        .fields.Update
    End With
End Sub
Sign up to request clarification or add additional context in comments.

Comments

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.