How can I send multiple emails through Gmail using VBA, with multiple set ranges referencing a cell range

Question

I have VBA code to send single emails via Excel (through Gmail).

Sub Gmail_Bulk_Sending()
   Dim NewMail As CDO.Message
   Dim mailConfig As CDO.Configuration
   Dim fields As Variant
   Dim msConfigURL As String
   On Error GoTo Err:

   'early binding
   Set NewMail = New CDO.Message
   Set mailConfig = New CDO.Configuration

   'load all default configurations
   mailConfig.Load -1

   Set fields = mailConfig.fields

   'Set All Email Properties
   With NewMail
       .From = "myemail"
       .To = ""
       .CC = ""
       .BCC = ""
       .Subject = "Hello There"
       .TextBody = "I really want to this VBA code to work"
    
   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") = "myemail" 'Your gmail address
       .Item(msConfigURL & "/sendpassword") = "XXXXXXXXX" 'Your password or App Password
       .Update 'Update the configuration fields
   End With
   NewMail.Configuration = mailConfig
   NewMail.Send
   
   MsgBox "Your email has been sent", vbInformation

Exit_Err:
   'Release object memory
   Set NewMail = Nothing
   Set mailConfig = Nothing
   End

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
   Case Else 'Report other errors
       MsgBox "Error encountered while sending email." & vbNewLine & Err.Number & ": " & Err.Description
   End Select

   Resume Exit_Err
End Sub

My Excel file is set up like this:
Column A = email addresses
Column B = Name of Persons corresponding to email addresses

My goal is to send multiple emails to different people (ex: A1 = email person 1) with .TextBody referencing the cell has the name (ex: B1 = name of person 1)

Example of the two variables and how it would look like in an email:

.To: Reference to cell "A1"
.TextBody: Hey "NAME" (from cell B1), I would like to...

I have seen some help on this but it is always Outlook and that code does not work with Gmail.

What is in row 1 of the sheet, is it a header line like Email, Name? — CDP1802, Mar 10 '23 at 11:17

score 0 · Answer 1 · answered Mar 10 '23 at 13:00

Option Explicit

Sub Gmail_Bulk_Sending()
 
    Const USERNAME = "myemail"
    Const PWD = "????"
    Const START_ROW = 2
    
    ' Create Email Config
    Const msConfigURL = "http://schemas.microsoft.com/cdo/configuration"
    Dim Config As CDO.Configuration
    Set Config = New CDO.Configuration
    With Config
        .Load -1 'cdoDefaults
        .fields.Item(msConfigURL & "/smtpusessl") = True 'Enable SSL Authentication
        .fields.Item(msConfigURL & "/smtpauthenticate") = 1 'SMTP authentication Enabled
        .fields.Item(msConfigURL & "/smtpserver") = "smtp.gmail.com"  'Set the SMTP server details
        .fields.Item(msConfigURL & "/smtpserverport") = 465 'Set the SMTP port Details
        .fields.Item(msConfigURL & "/sendusing") = 2 'Send using default setting
        .fields.Item(msConfigURL & "/sendusername") = USERNAME 'Your gmail address
        .fields.Item(msConfigURL & "/sendpassword") = PWD 'Your password or App Password
        .fields.Update
    End With
    
    ' create Email Message
    Dim email As CDO.Message
    Set email = New CDO.Message
    With email
        .Configuration = Config
        .From = USERNAME
        .CC = ""
        .BCC = ""
        .Subject = "Hello"
    End With
    
    Dim ws As Worksheet, lastrow As Long, i As Long, n As Long
    Dim sAddr As String, sName As String
    Set ws = ThisWorkbook.Sheets("Sheet1")
    With ws
        lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
        ' scan sheet
        For i = START_ROW To lastrow
            sAddr = .Cells(i, "A")
            sName = .Cells(i, "B")
            ' send email
            If sAddr Like "*@*" Then
                With email
                    .To = sAddr
                    .TextBody = "Hello " & sName
                    .Send
                End With
                n = n + 1
                ' delay 1 sec
                Application.Wait (Now + TimeValue("00:00:01"))
                'Debug.Print i, sAddr, sName
            End If
            .Cells(i, "A").Interior.Color = vbGreen ' mark
        Next
    End With
    MsgBox n & " emails sent", vbInformation

End Sub

Thank you very much for taking the time to write this, unfortunately - it does not work. Its telling me the its "undefined", giving up here as gmail has made it almost impossible to do this. I very much appreciate the time you have taken! :) thank you — CKD, Mar 19 '23 at 11:41
@CKD What is undefined. I have tested the code so I know it works, I also have code that sends emails using Thunderbird (not tried with gmail though) from the command line if that helps. — CDP1802, Mar 19 '23 at 11:43

How can I send multiple emails through Gmail using VBA, with multiple set ranges referencing a cell range

1 Answers1