Automating email using an If

[Lizard07]

I am trying to setup an automated email list each morning but I need to send out multiple emails to different contacts depending on what a specific cell indicates.

For instance, if a cell in column F says "PICY" then I need it to copy the adjacent cell's content in rows B and C into the email after the body message. The text in column F will also determine who the email is sent to. I have about 10 different cell options for column F that will determine who the email is sent to and what cell information is copied after the body message.

Sub SendStatusUpdateEmail()
Dim olApp As Outlook.Application
Dim olMail As MailItem
Dim CurrFile As String
Set olApp = New Outlook.Application
Set olMail = olApp.CreateItem(olMailItem)
ActiveWorkbook.Save
CurrFile = ActiveWorkbook.Path & "\" & ActiveWorkbook.Name
With olMail
.To = "aslkdfjlkja@mail.com"
.Subject = "Status Update"
.Body = ActiveSheet.Range("E2").Text & vbCrLf
.Display '.Send
End With
Set olMail = Nothing
Set olApp = Nothing
End Sub

 

[bensonsearch]

you need a valid email where my code says email@email.com, if testing insert your own email there so you get it. dont forget to add the other carriers in

 

[Lizard07]

Yes I know, I've been using a valid email address, I just put a fake one in when I posted it here

Any other ideas?

 

[bensonsearch]

What version of office are you using? this should send no problems in 2010

otherwise you may need to adjust the macro settings in outlook to trust all.