I am trying to get a macro to send an email to all emails in range where the cell to the left of the address = N but seem to be going round in circles and not quite getting it to work.
At the moment I am using the following code, all the Outlook bits work fine i.e. opening the template adding the recipient etc it is setting the recipo value I am having problems with.
The data on sheet CB Emails is as follows
A B
me@mycompany1.com N
me1@mycompany1.com Y
me2@mycompany1.com N
I would like to send an individual mail to each recipient where B=N, my current code is as follows.
_____________________________________________________
Sub chase()
If Reply = N Then
'Template email to be used'
Const MailTemplate = "P:\HR Operations\HRonly\HR Database Reporting\Cust Branch flags at payroll\Cap Badgeing\CapBadge Exercise Follow Up.oft"
'Accounts for Errors in Outlook'
On Error Resume Next
Set appOut = GetObject(, "Outlook.Application")
If appOut Is Nothing Then
Set appOut = CreateObject("Outlook.Application.")
blnCreate = True
If appOut Is Nothing Then
MsgBox "Unable to start Outlook.", vbOKOnly + vbCritical, "Send Mail"
Exit Sub
End If
End If
On Error GoTo 0
On Error Resume Next
Set OutMail = appOut.CreateItemFromTemplate(MailTemplate)
If OutMail Is Nothing Then
MsgBox "Unable to create item.", vbOKOnly + vbCritical, "Send Mail"
If blnCreate Then appOut.Quit
Set appOut = Nothing
Exit Sub
End If
On Error GoTo 0
'Attaches workbook to email, adds addresses and sends email'
With OutMail
.Recipients.Add recip
.Send
End With
If blnCreate Then appOut.Quit
Set OutMail = Nothing
Set appOut = Nothing
ActiveWindow.Close
End If
Next pers
End Sub
At the moment I am using the following code, all the Outlook bits work fine i.e. opening the template adding the recipient etc it is setting the recipo value I am having problems with.
The data on sheet CB Emails is as follows
A B
me@mycompany1.com N
me1@mycompany1.com Y
me2@mycompany1.com N
I would like to send an individual mail to each recipient where B=N, my current code is as follows.
_____________________________________________________
Sub chase()
- Sheets("CB Emails").Select
For pers = 1 To Range("A65536").End(xlUp).Row
Range("pers").Activate
Reply = ActiveCell.Offset(rowOffset:=0, columnOffset:=1).Valu
recip = pers.Value
If Reply = N Then
'Template email to be used'
Const MailTemplate = "P:\HR Operations\HRonly\HR Database Reporting\Cust Branch flags at payroll\Cap Badgeing\CapBadge Exercise Follow Up.oft"
'Accounts for Errors in Outlook'
On Error Resume Next
Set appOut = GetObject(, "Outlook.Application")
If appOut Is Nothing Then
Set appOut = CreateObject("Outlook.Application.")
blnCreate = True
If appOut Is Nothing Then
MsgBox "Unable to start Outlook.", vbOKOnly + vbCritical, "Send Mail"
Exit Sub
End If
End If
On Error GoTo 0
On Error Resume Next
Set OutMail = appOut.CreateItemFromTemplate(MailTemplate)
If OutMail Is Nothing Then
MsgBox "Unable to create item.", vbOKOnly + vbCritical, "Send Mail"
If blnCreate Then appOut.Quit
Set appOut = Nothing
Exit Sub
End If
On Error GoTo 0
'Attaches workbook to email, adds addresses and sends email'
With OutMail
.Recipients.Add recip
.Send
End With
If blnCreate Then appOut.Quit
Set OutMail = Nothing
Set appOut = Nothing
ActiveWindow.Close
End If
Next pers
End Sub