craneg
01-27-2016, 02:38 PM
Hi all,
I've been trying to create a macro that will allow me to send emails from Outlook 2010 using details from an excel 2010 spreadsheet. I have a list of email addresses in Column F, a list of reports in Column N and an IF function in Column D. What I'm trying to achieve is that when a report is due, the IF function in Column D shows the message "Send Reminder". I can then click the macro button and for all cells in Column D that shows "Send Reminder", Outlook will send an email to the corresponding email address in that row with the corresponding report title in that row. The code I have compiled so far is close, but as long as one cell in Column D shows "Send Reminder" it will send one email to every email address in Column F and with only the latest report. I have posted the code below and I would be extremely grateful if someone could give me some pointers. Thanks!
Private Sub CommandButton1_Click()
Dim OutLookApp As Object
Dim OutLookMailItem As Object
Dim iCounter As Integer
Dim MailDest As Range, cl As Range
Dim sTo As String
Set MailDest = Worksheets("AUAL").Range("F9:F181")
For Each cl In MailDest
sTo = sTo & ";" & cl.Value
Next
sTo = Mid(sTo, 2)
Set OutLookApp = CreateObject("OutLook.application")
Set OutLookMailItem = OutLookApp.CreateItem(0)
With OutLookMailItem
For iCounter = 9 To WorksheetFunction.CountA(Columns(6))
If Cells(iCounter, 6).Offset(0, -2) = "Send Reminder" Then
MailDest = Cells(iCounter, 6).Value
End If
Next iCounter
For iCounter = 9 To WorksheetFunction.CountA(Columns(14))
If Cells(iCounter, 14).Offset(0, -10) = "Send Reminder" Then
Report = Cells(iCounter, 14).Value
ElseIf Report <> "" And Cells(iCounter, 14).Offset(0, -10) = "Send Reminder" Then
Report = Report & ";" & Cells(iCounter, 14).Value
End If
Next
.To = sTo
.Subject = "Corporate Calendar Reminder"
.Body = "Please note that you have an upcoming report" & " '" & Report & "'. " & "in the next fortnight. Please ensure that this report is sent and provide a copy for Compliance"
.Display
End With
Set OutLookMailItem = Nothing
Set OutLookApp = Nothing
I've been trying to create a macro that will allow me to send emails from Outlook 2010 using details from an excel 2010 spreadsheet. I have a list of email addresses in Column F, a list of reports in Column N and an IF function in Column D. What I'm trying to achieve is that when a report is due, the IF function in Column D shows the message "Send Reminder". I can then click the macro button and for all cells in Column D that shows "Send Reminder", Outlook will send an email to the corresponding email address in that row with the corresponding report title in that row. The code I have compiled so far is close, but as long as one cell in Column D shows "Send Reminder" it will send one email to every email address in Column F and with only the latest report. I have posted the code below and I would be extremely grateful if someone could give me some pointers. Thanks!
Private Sub CommandButton1_Click()
Dim OutLookApp As Object
Dim OutLookMailItem As Object
Dim iCounter As Integer
Dim MailDest As Range, cl As Range
Dim sTo As String
Set MailDest = Worksheets("AUAL").Range("F9:F181")
For Each cl In MailDest
sTo = sTo & ";" & cl.Value
Next
sTo = Mid(sTo, 2)
Set OutLookApp = CreateObject("OutLook.application")
Set OutLookMailItem = OutLookApp.CreateItem(0)
With OutLookMailItem
For iCounter = 9 To WorksheetFunction.CountA(Columns(6))
If Cells(iCounter, 6).Offset(0, -2) = "Send Reminder" Then
MailDest = Cells(iCounter, 6).Value
End If
Next iCounter
For iCounter = 9 To WorksheetFunction.CountA(Columns(14))
If Cells(iCounter, 14).Offset(0, -10) = "Send Reminder" Then
Report = Cells(iCounter, 14).Value
ElseIf Report <> "" And Cells(iCounter, 14).Offset(0, -10) = "Send Reminder" Then
Report = Report & ";" & Cells(iCounter, 14).Value
End If
Next
.To = sTo
.Subject = "Corporate Calendar Reminder"
.Body = "Please note that you have an upcoming report" & " '" & Report & "'. " & "in the next fortnight. Please ensure that this report is sent and provide a copy for Compliance"
.Display
End With
Set OutLookMailItem = Nothing
Set OutLookApp = Nothing