PDA

View Full Version : Using VBA to send emails via outlook using excel cells



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

mancubus
01-27-2016, 11:42 PM
welcome to vbax craneg.

registering means you have read the forum rules. :devil
and as per forum rules, members should use code tags when posting code: http://www.vbaexpress.com/forum/faq.php?faq=new_faq_item#faq_contrib_faq_item

that said, try below. i am not sure if it Works or not, because your requirement seems unclear to me.



Sub vbax_54983_Send_Email_BasedOn_Condition()
Dim olApp As Object, olMail As Object
Dim i As Long

Set olApp = CreateObject("Outlook.Application")

Worksheets("AUAL").Activate

For i = 9 To Cells(Rows.Count, 6).End(xlUp).Row
If Cells(i, 4).Value = "Send Reminder" Then
Set olMail = olApp.CreateItem(olMailItem)
With olMail
.To = Cells(i, 6)
.Subject = "Corporate Calendar Reminder"
.Body = "Please note that you have an upcoming report '" & Cells(i, 14) & "' in the next fortnight. " & _
"Please ensure that this report is sent and provide a copy for Compliance."
.Display
'.Save
'.Send
End With
End If
Next
End Sub