Sending daily emails based on criteria, with email body corresponding to parallel cell which holds email address(es)

twinwings

Board Regular
Joined
Jul 25, 2012
Messages
69
Hello,

I am hoping to have a macro where I can send daily emails, with bodies are prepopulated from my worksheet.

The criteria to check IF an email can be sent is in column AH, which holds the successful command of "SEND" (if SEND, then macro to generate email, otherwise do nothing)

email address I need to send to is in column AB (in same row as the cell SEND in column AH)

body of email is in column AF.


I might need to combine multiple cells to build out the body, but for the moment, let's assume the entire body of email is in cells in column AF.


I tried a simplified version of my worksheet, using the macro from here: VBA Code for to send email from outlook based on Cell Value, but when I try to adapt it to my actual worksheet it seems to fail.


Here's the macro from the link, but modified for my columns. I really don't understand why it's not working


VBA Code:
Sub Mail_it()

'Look in column AH2 onward, where SEND would reside
LastRow = Range("AH" & Rows.Count).End(xlUp).Row

For i = 2 To LastRow

If UCase(Cells(i, 2).Value) = "SEND" Then

'Address is offset 1 column left, Mail Body 1 column right
     emailTo = Cells(i, 2 - 6).Value
    emailBody = Cells(i, 2 - 1).Value
    EmailSubject = Cells(i, 2 - 4).Value

Dim OutApp As Object
Dim OutMail As Object

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

  With OutMail
.To = emailTo
.CC = ""
.BCC = ""
.Subject = "This is the Subject line"
.Body = emailBody
'.Send
.Display
End With

Set OutMail = Nothing
Set OutApp = Nothing
End If


Next

End Sub
 

Excel Facts

Copy a format multiple times
Select a formatted range. Double-click the Format Painter (left side of Home tab). You can paste formatting multiple times. Esc to stop
Figured it out, thanks for the help

VBA Code:
Sub Mail_it()

'Look in column AI onward, where SEND would reside
LastRow = Range("AI" & Rows.Count).End(xlUp).Row

For i = 2 To LastRow

If UCase(Cells(i, 35).Value) = "SEND" Then

'Address is offset 1 column left, Mail Body 1 column right
    emailTo = Cells(i, 35 - 7).Value
    emailCC = Cells(i, 35 - 6).Value
    emailBody = Cells(i, 35 - 4).Value & vbCrLf & vbCrLf & Cells(i, 35 - 3).Value & vbCrLf & vbCrLf & Cells(i, 35 - 2).Value & vbCrLf & vbCrLf & Cells(i, 35 - 1).Value
    EmailSubject = Cells(i, 35 - 5).Value

Dim OutApp As Object
Dim OutMail As Object

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

  With OutMail
.To = emailTo
.CC = emailCC
.BCC = ""
.Subject = EmailSubject
.Body = emailBody
'.Send
.Display
End With

Set OutMail = Nothing
Set OutApp = Nothing
End If

'Cells(i, 2).Value = "NO"
Next

End Sub
 
Upvote 0
Solution

Forum statistics

Threads
1,215,077
Messages
6,122,991
Members
449,094
Latest member
masterms

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top