MikeSta4ord
04-29-2016, 11:55 AM
Hello,
I'm having trouble getting my macro to effectively send a mass email which is based on a message template set up in excel. The code I am attempting is:
Sub SendEmail(what_address As String, subject_line As String, mail_body As String)
Dim olApp As Outlook.Application
Set olApp = CreateObject("Outlook.Application")
Dim olMail As Outlook.MailItem
Set olMail = olApp.CreateItem(olMailItem)
olMail.To = what_address
olMail.Subject = subject_line
olMail.Body = mail_body
olMail.Send
End Sub
Sub SendMassEmail()
Row_number = 2
Do While Sheet10.Range("C" & Row_number) <> ""
DoEvents
Dim mail_body_message As String
Dim full_name As String
Dim project_name As String
Dim offer_number As String
Dim IPS_contact As String
Dim Customer_Email_Address As String
Dim Days_Expired As Integer
Dim Follow_up_column As Range
Dim i As Long
Customer_Email_Address = Sheet10.Range("A" & Row_number)
IPS_contact = Sheet10.Range("C" & Row_number)
mail_body_message = Sheet10.Range("I2")
Days_Expired = Sheet10.Range("H" & Row_number)
full_name = Sheet10.Range("G" & Row_number)
project_name = Sheet10.Range("E" & Row_number)
offer_number = Sheet10.Range("F" & Row_number)
mail_body_message = Replace(mail_body_message, "Days_Expired", Days_Expired)
mail_body_message = Replace(mail_body_message, "IPS_Contact", IPS_contact)
mail_body_message = Replace(mail_body_message, "Customer_Email_Address", Customer_Email_Address)
mail_body_message = Replace(mail_body_message, "Offer_number", offer_number)
mail_body_message = Replace(mail_body_message, "Customer_name", full_name)
mail_body_message = Replace(mail_body_message, "Project_name", project_name)
Call SendEmail(Sheet10.Range("D" & Row_number), "Reminder to send followup email", mail_body_message)
Row_number = Row_number + 1
Loop
Set Follow_up_column = Sheet3.Range("R2:R10000")
For i = 2 To 10000
If Follow_up_column.Cells(i).Value = "Yes" Then
Follow_up_column.Cells(i).Value = "Reminder Sent"
MsgBox "Reminders Sent!"
End If
Next i
End Sub
It's not giving me a particular error but nothing is happening after I execute the macro. So I suppose I am missing something within the code for it to execute correctly. It is also supposed to be deleting the data in the email tab when it sends out the email, and changing yes in the proposal log to "Reminder sent". It worked fine a couple weeks ago but has gone inactive since I updated the macro to include more rows. I've had others test the code on office 2007 and 2010 and it works as it's suppose to so there might be with an issue with my office 2016.
I will attach a sample file to show you the excel file I am working with. You have to input an email address to test the macro on yourself. Please let me know if you need anything else from me.
Thank-You very much for the help
Mike
I'm having trouble getting my macro to effectively send a mass email which is based on a message template set up in excel. The code I am attempting is:
Sub SendEmail(what_address As String, subject_line As String, mail_body As String)
Dim olApp As Outlook.Application
Set olApp = CreateObject("Outlook.Application")
Dim olMail As Outlook.MailItem
Set olMail = olApp.CreateItem(olMailItem)
olMail.To = what_address
olMail.Subject = subject_line
olMail.Body = mail_body
olMail.Send
End Sub
Sub SendMassEmail()
Row_number = 2
Do While Sheet10.Range("C" & Row_number) <> ""
DoEvents
Dim mail_body_message As String
Dim full_name As String
Dim project_name As String
Dim offer_number As String
Dim IPS_contact As String
Dim Customer_Email_Address As String
Dim Days_Expired As Integer
Dim Follow_up_column As Range
Dim i As Long
Customer_Email_Address = Sheet10.Range("A" & Row_number)
IPS_contact = Sheet10.Range("C" & Row_number)
mail_body_message = Sheet10.Range("I2")
Days_Expired = Sheet10.Range("H" & Row_number)
full_name = Sheet10.Range("G" & Row_number)
project_name = Sheet10.Range("E" & Row_number)
offer_number = Sheet10.Range("F" & Row_number)
mail_body_message = Replace(mail_body_message, "Days_Expired", Days_Expired)
mail_body_message = Replace(mail_body_message, "IPS_Contact", IPS_contact)
mail_body_message = Replace(mail_body_message, "Customer_Email_Address", Customer_Email_Address)
mail_body_message = Replace(mail_body_message, "Offer_number", offer_number)
mail_body_message = Replace(mail_body_message, "Customer_name", full_name)
mail_body_message = Replace(mail_body_message, "Project_name", project_name)
Call SendEmail(Sheet10.Range("D" & Row_number), "Reminder to send followup email", mail_body_message)
Row_number = Row_number + 1
Loop
Set Follow_up_column = Sheet3.Range("R2:R10000")
For i = 2 To 10000
If Follow_up_column.Cells(i).Value = "Yes" Then
Follow_up_column.Cells(i).Value = "Reminder Sent"
MsgBox "Reminders Sent!"
End If
Next i
End Sub
It's not giving me a particular error but nothing is happening after I execute the macro. So I suppose I am missing something within the code for it to execute correctly. It is also supposed to be deleting the data in the email tab when it sends out the email, and changing yes in the proposal log to "Reminder sent". It worked fine a couple weeks ago but has gone inactive since I updated the macro to include more rows. I've had others test the code on office 2007 and 2010 and it works as it's suppose to so there might be with an issue with my office 2016.
I will attach a sample file to show you the excel file I am working with. You have to input an email address to test the macro on yourself. Please let me know if you need anything else from me.
Thank-You very much for the help
Mike