I want to send a bulk email from Excel 2000 to a list of advertisers telling them that their advertising copy is overdue. I have found some VBA code on Ron de Bruin’s website ( which seems to fit the bill. Here’s the code:
'***begin code
Sub TestFile()
Dim OutApp As Outlook.Application
Dim OutMail As Outlook.MailItem
Dim cell As Range
Application.ScreenUpdating = False
Set OutApp = CreateObject("Outlook.Application")
On Error GoTo cleanup
For Each cell In Sheets("Sheet1").Columns("B").Cells.SpecialCells(xlCellTypeConstants)
If cell.Value Like "?*@?*.?*" And LCase(cell.Offset(0, 1).Value) = "yes" Then
Set OutMail = OutApp.CreateItem(olMailItem)
With OutMail
.To = cell.Value
.Subject = "Reminder"
.Body = "Dear " & cell.Offset(0, -1).Value & vbNewLine & vbNewLine & _
"Please contact us to discuss bringing your account up to date"
'You can add other files also like this
'.Attachments.Add ("C:\test.txt")
.Send 'Or use Display
End With
Set OutMail = Nothing
End If
Next cell
cleanup:
Set OutApp = Nothing
Application.ScreenUpdating = True
End Sub
'***end code
I’ve test the code and it works fine using his basic example (ie making a list in Sheet (“Sheet1”) with 3 columns. Column A = name; Column B = Email & Column C = Yes/No
However, I have some extra columns which I want to format in a precise order. The columns are as follows:
Primary Contact Email (E-mail address)
Secondary Contact Email(E-mail address)
Publication (txt)
Space Booked (txt)
Brand/Product Name (text)
Specs Sent (date)
Copydate (date)
I want my email to format as follows:
Email to: [Primary Contact Email]
Cc to: [Secondary Contact ] - only if filled in
Subject: [Publication] – [Space Booked] – [Brand/Product Name] – “Overdue Advertising”
Message:
Dear [Copy Contact Email],
We emailed specs to on [Specs Sent] with a copydate of [Copydate]. We must receive your advert by 15/9.
Regards,
Square Meal
Can anyone help me with the VBA if possible?
'***begin code
Sub TestFile()
Dim OutApp As Outlook.Application
Dim OutMail As Outlook.MailItem
Dim cell As Range
Application.ScreenUpdating = False
Set OutApp = CreateObject("Outlook.Application")
On Error GoTo cleanup
For Each cell In Sheets("Sheet1").Columns("B").Cells.SpecialCells(xlCellTypeConstants)
If cell.Value Like "?*@?*.?*" And LCase(cell.Offset(0, 1).Value) = "yes" Then
Set OutMail = OutApp.CreateItem(olMailItem)
With OutMail
.To = cell.Value
.Subject = "Reminder"
.Body = "Dear " & cell.Offset(0, -1).Value & vbNewLine & vbNewLine & _
"Please contact us to discuss bringing your account up to date"
'You can add other files also like this
'.Attachments.Add ("C:\test.txt")
.Send 'Or use Display
End With
Set OutMail = Nothing
End If
Next cell
cleanup:
Set OutApp = Nothing
Application.ScreenUpdating = True
End Sub
'***end code
I’ve test the code and it works fine using his basic example (ie making a list in Sheet (“Sheet1”) with 3 columns. Column A = name; Column B = Email & Column C = Yes/No
However, I have some extra columns which I want to format in a precise order. The columns are as follows:
Primary Contact Email (E-mail address)
Secondary Contact Email(E-mail address)
Publication (txt)
Space Booked (txt)
Brand/Product Name (text)
Specs Sent (date)
Copydate (date)
I want my email to format as follows:
Email to: [Primary Contact Email]
Cc to: [Secondary Contact ] - only if filled in
Subject: [Publication] – [Space Booked] – [Brand/Product Name] – “Overdue Advertising”
Message:
Dear [Copy Contact Email],
We emailed specs to on [Specs Sent] with a copydate of [Copydate]. We must receive your advert by 15/9.
Regards,
Square Meal
Can anyone help me with the VBA if possible?