Email Blast

Function Email_Blast()

'Reading from Database cell

Dim db As DAO.Database

Dim rs As DAO.Recordset

Set db = CurrentDb

'Set rs = New ADODB.Recordset

Set rs = db.OpenRecordset("select * from EMAIL_BLAST")

'DoCmd.GoToRecord , "data", acNewRec

rs.OpenRecordset

With rs

While (Not .EOF)

contract_id_var = rs.Fields("[contract_id]")

customer_name_var = rs.Fields("[customer_name]")

ar_address1_var = rs.Fields("[ar_address1]")

ar_address2_var = rs.Fields("[ar_address2]")

ar_city_var = rs.Fields("[ar_city]")

ar_state_var = rs.Fields("[ar_state]")

ar_zip_var = rs.Fields("[ar_zip]")

nmf_contact_email_var = rs.Fields("[nmf_contact_email]")

am_addl_email_var = rs.Fields("[am_addl_email]")

Assigned_To_var = rs.Fields("[Assigned To]")

Expiration_date_var = rs.Fields("[Expiration_date]")

'Checking Email Exist

If IsNull(nmf_contact_email_var) And IsNull(am_addl_email_var) Then

Dim db1 As DAO.Database

Dim rs1 As DAO.Recordset

Set db1 = CurrentDb

'Set rs = New ADODB.Recordset

Set rs1 = db.OpenRecordset("EMAIL_BLAST_FAIL_REPORT", dbOpenDynaset)

rs1.AddNew

rs1![Reject Resolution] = "New Sales Tax Certificated Needed"

rs1.Fields("[contract_id]") = contract_id_var

rs1.Fields("[customer_name]") = customer_name_var

rs1.Fields("[ar_address1]") = ar_address1_var

rs1.Fields("[ar_address2]") = ar_address2_var

rs1.Fields("[ar_city]") = ar_city_var

rs1.Fields("[ar_state]") = ar_state_var

rs1.Fields("[ar_zip]") = ar_zip_var

rs1.Fields("[nmf_contact_email]") = nmf_contact_email_var

rs1.Fields("[am_addl_email]") = am_addl_email_var

rs1.Fields("[Assigned To]") = Assigned_To_var

rs1.Fields("[Expiration_date]") = Expiration_date_var

rs1![Report_Date] = Date

rs1.Update

rs1.Close

Dim db2 As DAO.Database

Dim rs2 As DAO.Recordset

Set db2 = CurrentDb

'Set rs = New ADODB.Recordset

Set rs2 = db.OpenRecordset("Select * from Employee")

rs2.OpenRecordset

With rs2

While (Not .EOF)

First_Name_var = rs2.Fields("[First_Name]")

Last_Name_var = rs2.Fields("[Last_Name]")

Email_var = rs2.Fields("[Email]")

Title_var = rs2.Fields("[Title]")

Set MyApp = CreateObject("Outlook.Application")

Set MyItem = MyApp.CreateItem(0)

With MyItem

.To = Email_var

.Subject = "EMAIL BLAST FAIL REPORT - " & contract_id_var

.ReadReceiptRequested = False

.HTMLBody = "The Followign contract fail to send an email. There is no email on file. Contract: " & contract_id_var & ". Customer Name: " & customer_name_var

End With

MyItem.Display

rs2.MoveNext

Wend

rs2.Close

End With

GoTo ContinueProcess

End If

'Sending Email

Dim myUser As String

myUser = Environ("username")

'Message using HTML

'If Address 2 is not empty

If Not IsNull(ar_address2_var) Then

EBody = " Today is " & Date & " - " & Time & "<br />" & "<br />" _

& customer_name_var & "<br />" _

& ar_address1_var & "<br />" _

& ar_address2_var & "<br />" _

& ar_city_var & ", " & ar_state_var & ", " & ar_zip_var & "<br />" & "<br />" _

& "RE: Contract: " & "<b>" & contract_id_var & "</b>" & "<br />" & "<br />" _

& "Dear Customer," & "<br />" & "<br />" _

& "The current sales tax exempt certificate we have on file for " & "<b style=color:red;>" & customer_name_var & "</b>" & " has expired, as of " & "<b style=color:red;>" & Expiration_date_var & "</b>" & "." & "<br />" & "<br />" _

& "In order for your contract to remain tax exempt and not taxable, the Tax Exemption renewal must be sent immediately." & "<br />" & "<br />" _

& "Please reply to this email with your current sales tax certificate." & "<br />" & "<br />" _

& "Thank You" & "<br />" & "<br />" _

& "SS Department" & "<br />" _

& "904-444-4444 (Phone)" & "<br />" _

& "888-999-9999 (Fax)" & "<br />" _

& "servops@sharedfinserv.com" & "<br />"

End If

'Message using HTML

'If Address 2 is empty

If IsNull(ar_address2_var) Then

EBody = " Today is " & Date & " - " & Time & "<br />" & "<br />" _

& customer_name_var & "<br />" _

& ar_address1_var & "<br />" _

& ar_city_var & ", " & ar_state_var & ", " & ar_zip_var & "<br />" & "<br />" _

& "RE: Contract: " & "<b>" & contract_id_var & "</b>" & "<br />" & "<br />" _

& "Dear Customer," & "<br />" & "<br />" _

& "The current sales tax exempt certificate we have on file for " & "<b style=color:red;>" & customer_name_var & "</b>" & " has expired, as of " & "<b style=color:red;>" & Expiration_date_var & "</b>" & "." & "<br />" & "<br />" _

& "In order for your contract to remain tax exempt and not taxable, the Tax Exemption renewal must be sent immediately." & "<br />" & "<br />" _

& "Please reply to this email with your current sales tax certificate." & "<br />" & "<br />" _

& "Thank You" & "<br />" & "<br />" _

& "SS Department" & "<br />" _

& "904-444-4444 (Phone)" & "<br />" _

& "888-999-9999 (Fax)" & "<br />" _

& "servops@sharedfinserv.com" & "<br />"

End If

Set MyApp = CreateObject("Outlook.Application")

Set MyItem = MyApp.CreateItem(0)

With MyItem

.To = nmf_contact_email_var

.CC = am_addl_email

.SentOnBehalfOfName = "sales@domain.com"

.Subject = "Immediate Attention Required. Please remit documentation"

.ReadReceiptRequested = False

.HTMLBody = EBody

End With

MyItem.Display

ContinueProcess:

.MoveNext

Wend

rs.Close

End With

End Function