Signature Image in GMail email body

M

Momma

Member
Local time
Today, 12:24
Joined
Jan 22, 2022
Messages
130
Hi there

I'm sending bulk emails through my Gmail account. The emails are sending but does not include the signature image at the end.
Can somebody help me with the right code, please?
Thank you!

Code: 
Private Sub CmdEmailReview_Click()
    Dim strText As String
    Dim HTMLBody As String
    Dim i As Long
    Dim txt_To As String
    Dim txt_Subject As String
    Dim txt_Message As String
    Dim txt_CC As String
    Dim txt_BCC As String
    Dim cbo_Importance As Long
    Dim cbo_EmailFormat As Long
    Dim ContactID
    
    txt_CC = ""
    txt_BCC = ""
    cbo_Importance = 1
    cbo_EmailFormat = 1
    
    strText = "z:\EmailFiles\Review.htm"
    Set Attachment = Message.AddRelatedBodyPart(CurrentDBDir() & imageName2, imageName2, cdoRefTypeId)
            Attachment.Fields.Item("urn:schemas:mailheader:Content-ID") = "<imageId2>"
        
    If Forms!frmContactEmails!ContactList.ItemsSelected.Count < 1 Then
        Exit Sub
    End If
    Status "Sending Emails..."

    For i = 0 To Forms!frmContactEmails!ContactList.ListCount - 1
    
        If Forms!frmContactEmails!ContactList.Selected(i) Then
            txt_To = Forms!frmContactEmails!ContactList.Column(2, i)
            txt_Subject = "Request for a Review"
            ContactID = Forms!frmContactEmails!ContactList.Column(0, i)
            'HTMLBody = "<HTML><BODY style=font-family:Arial; style=font-size:18px>" & strBody & "<IMG src=z:\EmailFiles\Logo.png><br>"
            HTMLBody = "<font face=Arial><p>" & "Dear " & Forms!frmContactEmails!ContactList.Column(1, i) & ReadTextFile(strText) & "</p>"
            txt_Message = HTMLBody & "<IMG src=z:\EmailFiles\Logo.jpg><br>"
            
            If GMail_Email(txt_To, txt_Subject, txt_Message, Nz(txt_CC), Nz(txt_BCC), cbo_Importance, cbo_EmailFormat) Then
                DoCmd.RunSQL "INSERT INTO tblCorrespondence (ContactID, CorrDate, Notes, CorrType) " & _
                    "VALUES (" & ContactID & "," & Format(Now(), "\#dd\-mmm\-yyyy\#") & ",""" & "Request a Review" & """,""" & "Email" & """)"
            Else
                DoCmd.RunSQL "INSERT INTO tblCorrespondence (ContactID, CorrDate, Notes, CorrType) " & _
                 "VALUES (" & ContactID & "," & Format(Now(), "\#dd\-mmm\-yyyy\#") & ",""" & "Email not sent" & """,""" & "Email" & """)"
          
            End If
        End If
        Sleep 1000
    Next
        Status "Done!!"
        Beep

End Sub
 
Maybe we need to see the code for the Gmail_Email() function?
 
theDBguy said:
Maybe we need to see the code for the Gmail_Email() function?
Click to expand...
This code was released by D Pineault on Youtube a while ago. The only thing he didn't include was attachments.

Code: 
Public Function GMail_Email(ByVal sTo As String, _
                            ByVal sSubject As String, _
                            ByVal sMessage As String, _
                            Optional sCC As String, _
                            Optional sBCC As String, _
                            Optional lImportance As EmailImportance = NormalImportance, _
                            Optional lEmailContentType As EmailContentType = HTML) As Boolean
    Dim sContentType              As String
    Dim sURL                  As String
    Dim sHTTPRequest          As String

    If OAuth2.access_token = "" Then OAuth2_StoredCredentials_Load    'Make sure we have credential before proceeding
    If OAuth2_CheckToken = False Then DoCmd.OpenForm sAuthenticationForm, , , , , acDialog 'Force authentication if req'd
    sContentType = "application/json"
    sURL = "https://gmail.googleapis.com/gmail/v1/users/me/drafts"

    sHTTPRequest = "to:" & sTo & vbCrLf
    If sCC <> "" Then sHTTPRequest = sHTTPRequest & "cc:" & sCC & vbCrLf
    If sBCC <> "" Then sHTTPRequest = sHTTPRequest & "bcc:" & sBCC & vbCrLf
    If lImportance = LowImportance Then
        sHTTPRequest = sHTTPRequest & "importance:low" & vbCrLf
    ElseIf lImportance = NormalImportance Then
        sHTTPRequest = sHTTPRequest & "importance:normal" & vbCrLf
    ElseIf lImportance = HighImportance Then
        sHTTPRequest = sHTTPRequest & "importance:high" & vbCrLf
    End If
    sHTTPRequest = sHTTPRequest & "subject:" & sSubject & vbCrLf
    If lEmailContentType = HTML Then
        sHTTPRequest = sHTTPRequest & "content-type:text/html" & vbCrLf
    ElseIf lEmailContentType = PlainText Then
        sHTTPRequest = sHTTPRequest & "content-type:text/plain" & vbCrLf
    End If
    sHTTPRequest = sHTTPRequest & vbCrLf & Replace(sMessage, """", "\""")

    sHTTPRequest = EncodeBase64(sHTTPRequest)    'Encode the string
    sHTTPRequest = "{""message"": {""raw"": """ & sHTTPRequest & """}}"
    Call HTTP_SendRequest(sURL, , sContentType, sHTTPRequest, True)
    If lHTTP_Status = 200 Then    'Draft created successfully
        'Send the created draft
        sURL = "https://gmail.googleapis.com/gmail/v1/users/me/drafts/send"
        sHTTPRequest = sHTTP_ResponseText
        Call HTTP_SendRequest(sURL, , sContentType, sHTTPRequest, True)
        If lHTTP_Status = 200 Then ' Could verify the labelIds value === SENT?
            GMail_Email = True
        End If
    End If
End Function
 
I am aware of that but the technique might be the same. Where is the signature located? You are using Gmail on-line, not managing with local app like Outlook or Mail?

Otherwise, embed an image file at end of email with HTML <img> tag.
 
Perhaps this threat helps you.

Add Images in CDO mail message HTMLBody

Hey guys, again me and my mail troubles :D Dim FileName As String Dim emailText As Stringt Dim iMsg As Object Dim iConf As Object Dim strbody As String Dim Flds As Variant Dim varReturn As Variant Dim objImage As Object Dim myPic As String If Not MyRs.EOF...
www.access-programmers.co.uk
 
You must log in or register to reply here.

Similar threads

M
Solved Type mismatch
Replies
16
Views
272
DickyP
DickyP
M
Solved Format Email Body
Replies
4
Views
221
xavier.batlle
X
M
Hyperlink in Email
Replies
1
Views
408
Edgar_
E
D
Default Signature new outlook current user
Replies
17
Views
351
GPGeorge
GPGeorge
E
SendKeys "%{S}" Not Working anymore?
Replies
7
Views
166
Gasman
Gasman

Users who are viewing this thread

Total: 1 (members: 0, guests: 1)
Back
Top Bottom