robgoldstein
Board Regular
- Joined
- Oct 26, 2013
- Messages
- 165
- Office Version
- 2019
- Platform
- Windows
I am trying to send a mail merge using VBA. I based it on code I got from this tutorial https://www.youtube.com/watch?v=WoCuRFEuACg&t=289s and then made some changes.
When I tested it after changing the subject info, but not the message yet I got an error saying At least one Recipient is required, but none were found.
Here is a dropbox link to the file
https://www.dropbox.com/s/t630m7oufn8ax2m/GTISL Game Sheet test.xlsm?dl=0
Any help to get this finished would be greatly appreciated.
When I tested it after changing the subject info, but not the message yet I got an error saying At least one Recipient is required, but none were found.
Here is a dropbox link to the file
https://www.dropbox.com/s/t630m7oufn8ax2m/GTISL Game Sheet test.xlsm?dl=0
Any help to get this finished would be greatly appreciated.
Code:
Sub SendWith_SMTP_Gmail()
'Works On Windows (Not Mac). Mac Users Should Use Zapier Integration
'Created by Randy Austin www.ExcelForFreelancers.com
Dim EmailMsg, EmailConf As Object
Dim Subj, Mess, Json, URL, LastName, FirstName, Team, GameDate, GameTime, GameLocation, Field, Email, Attach As String
Dim ContactRow, LastRow, SentCounter As Long
Dim EmailFields As Variant
Set EmailMsg = CreateObject("CDO.Message") 'CDO (Collaboration Data Objects) -Make sure you have the 'CDO For Windows' Library Selected
Set EmailConf = CreateObject("CDO.Configuration")
EmailConf.Load -1 ' Set CDO Source Defaults
Set EmailFields = EmailConf.Fields
With EmailFields
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com"
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 465
.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "sctoronto2011boys@gmail.com"
.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "2011soccer"
.Update
End With
With Sheet1
Subj = .Range("A53").Value 'Email Subject
Mess = .Range("A54").Value 'Email Message
Attach = .Range("F11").Value 'Attachment Link
LastRow = .Range("M999").End(xlUp).Row 'Get Last Row Of Table
For ContactRow = 2 To 52
If .Range("I" & ContactRow).Value = "not scheduled this week" Then GoTo NextRow
LastName = .Range("D" & ContactRow).Value
FirstName = .Range("C" & ContactRow).Value
Email = .Range("M" & ContactRow).Value
Team = .Range("H" & ContactRow).Value
GameDate = .Range("I" & ContactRow).Value
GameTime = .Range("K" & ContactRow).Value
GameLocation = .Range("J" & ContactRow).Value
Field = .Range("L" & ContactRow).Value
Subj = Replace(Replace(Subj, "#gamedate#", GameDate), "#LastName#", LastName)
Mess = Replace(Replace(Mess, "#FirstName#", FirstName), "#LastName#", LastName)
With EmailMsg
Set .Configuration = EmailConf
.To = Email
.CC = ""
.BCC = ""
.From = """SC Toronto U9 Boys"" <sctoronto2011boys@gmail.com>"
.Subject = Subj
If Attach <> Empty Then .AddAttachment Attach
.TextBody = Mess
.Send
End With
SentCounter = SentCounter + 1
.Range("P" & ContactRow).Value = Now 'Set Send Date & Time
NextRow:
Next ContactRow
'Cleanup
Set EmailMsg = Nothing
Set EmailConf = Nothing
Set EmailFields = Nothing
End With
MsgBox SentCounter & " Emails have been sent"
End Sub
