big45feet
01-18-2015, 05:07 PM
Hi all,
I am a newbie to VBA and am having diffculty getting my code to work for more than one email addresss.
What I am trying ACHIEVE is send emails to those with the reservation date (column K) highligthed in red which will have an associated drawing number and date in the body of the email. I have managed to create this for 1st recipient but i'm having trouble looping through the contacts and sending everyone else with there date highligthed in red an individual email with there specialsed drawing number and reservation date.
Here is what i have so far, i have also included a screenshot of the spreadsheet
Sub SendReminderMail()
Dim OutLookApp As Outlook.Application
Dim OutLookMailItem As Outlook.MailItem
Dim C As Integer
Dim C2 As Integer
Dim MailDest As String
Dim DrawNum As String
''Allow access to OutLook
Set OutLookApp = CreateObject("OutLook.Application")
Set OutLookMailItem = OutLookApp.CreateItem(0)
On Error GoTo cleanup
DrawNum = ""
For C2 = 1 To WorksheetFunction.CountA(Columns(11)) 'counter increments as it passes through the rows of Column 11 or K = reservation expiry
If DrawNum = "" And Cells(C2, 11).Interior.ColorIndex = 3 Then 'the drawing numbers with there expiry dates highligthed in red will be collected
DrawNum = Cells(C2, 11).Offset(0, -9).Value
ElseIf DrawNum <> "" And Cells(C2, 11).Interior.ColorIndex = 3 Then
DrawNum = "Your reservation for Electrical Drawing Number: " & Cells(C2, 11).Offset(0, -9).Value & " expires on the " & Cells(C2, 11).Value & "."
End If
MailDest = ""
For C = 1 To WorksheetFunction.CountA(Columns(11)) 'counter increments as it passes through the rows of Column 11 or K = reservation expiry
If MailDest = "" And Cells(C, 11).Interior.ColorIndex = 3 Then 'the emails with there expiry date highligthed in red will be collected
MailDest = Cells(C, 11).Offset(0, 1).Value 'And DrawNum = Cells(C, 11).Offset(0, -9).Value
ElseIf MailDest <> "" And Cells(C, 11).Interior.ColorIndex = 3 Then
MailDest = Cells(C, 11).Offset(0, 1).Value
End If
Next C
Next C2
With OutLookMailItem
.To = MailDest
.Subject = "Electrical Drawing Reminder"
.Body = DrawNum
.Display
End With
On Error Resume Next
Set OutLookApp = Nothing
Set OutLookMailItem = Nothing
On Error GoTo 0
''once email is sent OutLookMailItem and OutLookApp are intialised
''error blocker, blocks irrelevant or neigible error messages from appearing
cleanup:
Set OutLookApp = Nothing
Application.ScreenUpdating = True
End Sub
I am a newbie to VBA and am having diffculty getting my code to work for more than one email addresss.
What I am trying ACHIEVE is send emails to those with the reservation date (column K) highligthed in red which will have an associated drawing number and date in the body of the email. I have managed to create this for 1st recipient but i'm having trouble looping through the contacts and sending everyone else with there date highligthed in red an individual email with there specialsed drawing number and reservation date.
Here is what i have so far, i have also included a screenshot of the spreadsheet
Sub SendReminderMail()
Dim OutLookApp As Outlook.Application
Dim OutLookMailItem As Outlook.MailItem
Dim C As Integer
Dim C2 As Integer
Dim MailDest As String
Dim DrawNum As String
''Allow access to OutLook
Set OutLookApp = CreateObject("OutLook.Application")
Set OutLookMailItem = OutLookApp.CreateItem(0)
On Error GoTo cleanup
DrawNum = ""
For C2 = 1 To WorksheetFunction.CountA(Columns(11)) 'counter increments as it passes through the rows of Column 11 or K = reservation expiry
If DrawNum = "" And Cells(C2, 11).Interior.ColorIndex = 3 Then 'the drawing numbers with there expiry dates highligthed in red will be collected
DrawNum = Cells(C2, 11).Offset(0, -9).Value
ElseIf DrawNum <> "" And Cells(C2, 11).Interior.ColorIndex = 3 Then
DrawNum = "Your reservation for Electrical Drawing Number: " & Cells(C2, 11).Offset(0, -9).Value & " expires on the " & Cells(C2, 11).Value & "."
End If
MailDest = ""
For C = 1 To WorksheetFunction.CountA(Columns(11)) 'counter increments as it passes through the rows of Column 11 or K = reservation expiry
If MailDest = "" And Cells(C, 11).Interior.ColorIndex = 3 Then 'the emails with there expiry date highligthed in red will be collected
MailDest = Cells(C, 11).Offset(0, 1).Value 'And DrawNum = Cells(C, 11).Offset(0, -9).Value
ElseIf MailDest <> "" And Cells(C, 11).Interior.ColorIndex = 3 Then
MailDest = Cells(C, 11).Offset(0, 1).Value
End If
Next C
Next C2
With OutLookMailItem
.To = MailDest
.Subject = "Electrical Drawing Reminder"
.Body = DrawNum
.Display
End With
On Error Resume Next
Set OutLookApp = Nothing
Set OutLookMailItem = Nothing
On Error GoTo 0
''once email is sent OutLookMailItem and OutLookApp are intialised
''error blocker, blocks irrelevant or neigible error messages from appearing
cleanup:
Set OutLookApp = Nothing
Application.ScreenUpdating = True
End Sub