Skip to content

Instantly share code, notes, and snippets.

@wadewegner
Created January 5, 2021 05:51
Show Gist options
  • Save wadewegner/28a370f8f5b83fccd2bea082b4bc090e to your computer and use it in GitHub Desktop.
Save wadewegner/28a370f8f5b83fccd2bea082b4bc090e to your computer and use it in GitHub Desktop.
Sub BulkMail()
Application.ScreenUpdating = False
ThisWorkbook.Activate
Dim OutApp As Outlook.Application
Dim outMail As Outlook.MailItem
'Creating variable to hold values of different items of mail
Dim sendTo, subj, atchmnt, msg, ccTo, bccTo, giftcard As String
Dim lstRow As Long
ThisWorkbook.Sheets("Sheet1").Activate
lstRow = Cells(Rows.Count, 3).End(xlUp).Row
Dim rng As Range
Set rng = Range("B2:B" & lstRow)
Set OutApp = New Outlook.Application
On Error GoTo cleanup
' choose which account to send from
Set OutAccount = OutApp.Session.Accounts.Item(1)
For Each cell In rng
sendTo = Range(cell.Address).Offset(0, 0).Value2
giftcard = Range(cell.Address).Offset(0, 1).Value2
msg = "Welcome back! This is going to be a great year and we're so thankful for your hard work and dedication." & vbNewLine & vbNewLine & _
"Please accept this gift as a token of our appreciation: " & giftcard & vbNewLine & vbNewLine & _
"With gratitude," & vbNewLine & _
"<snip> PTSA"
On Error Resume Next
Set outMail = OutApp.CreateItem(0)
With outMail
.To = sendTo
.Body = msg
.Subject = "Welcome to 2021!"
.SendUsingAccount = OutAccount
.Send
End With
On Error GoTo 0
Set outMail = Nothing
Next cell
cleanup:
Set OutApp = Nothing
Set OutAccount = Nothing
Application.ScreenUpdating = True
Application.ScreenUpdating = True
End Sub
@wadewegner
Copy link
Author

For this to work:

  • Create three columns: Name, Email, Link
  • Make sure you have a header row (or change range to B1:B1.
  • If you only have one registered email account you cant remove the OutAccount in lines 24 and 43.

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment