Damian40
07-26-2016, 10:47 AM
Hello Everyone,
I'm currently using the following VBA script to run an auto e-mail within an Excel workbook. However, currently the workbook needs to be open and a macro button needs to be clicked in order for the e-mail to be created and sent. Another thing is the e-mail is currently sending to multiple users that are retrieved from a specific column and placed within the BCC column in order for them to be unable to view all of the recipients.
I would like to modify the code to include a new column containing point of contact e-mail addresses, as well as have the macro built so the user can simply click a button within their desktop and have the e-mails created and sent whether the Excel file is open or closed. I would also like to be able to break up the e-mails to be individual e-mails sent to the vendor and point of contact for that vendor instead of multiple recipients all within the BCC section. Here is the code I'm currently using:
Sub Button2_Click()
Dim OutLookApp As Object
Dim OutLookMailItem As Object
Dim iCounter As Integer
Dim MailDest As String
Set OutLookApp = CreateObject("Outlook.application")
Set OutLookMailItem = OutLookApp.CreateItem(0)
Worksheets("Agreements").Activate
With OutLookMailItem
MailDest = ""
For iCounter = 2 To WorksheetFunction.CountA(Columns(28))
If Len(Cells(iCounter, 28).Offset(0, -1)) > 0 Then
If MailDest = "" And Cells(iCounter, 28).Offset(0, -1) = "EXPIRED" Then
MailDest = Cells(iCounter, 28).Value
ElseIf MailDest <> "" And Cells(iCounter, 28).Offset(0, -1) = "EXPIRED" Then
MailDest = MailDest & ";" & Cells(iCounter, 28).Value
End If
End If
Next iCounter
.To = generic e-mail
.BCC = MailDest
.Subject = "Insurance Verification"
.HTMLBody = "To Whom It May Concern,
" _
& "Please be advised the certificate of insurance we have on file has expired. " _
& "Please provide an updated certificate of insurance as quickly as possible. " _
& "We are currently out of compliance.
" _
& "Please email updated policy to e-mail address
" _
& "Thank You,
" & "John Doe
" _
& "Internal Auditor
" & "Central Region
" _
& "123 American Highway
" & "City, ST 11111
" _
& "Phone: 954-999-9999 Ext. 123-4567"
.Display '.Send
End With
Set OutLookMailItem = Nothing
Set OutLookApp = Nothing
End Sub
I was thinking perhaps I could possibly add this bit of code after the Next iCounter line in the existing code:
MailDest2 = ""
For iCounter2 = 2 To WorksheetFunction.CountB(Columns(29))
If Len(Cells(iCounter2, 29).Offset(0, -2)) > 0 Then
If MailDest2 = "" And Cells(iCounter2, 29).Offset(0, -2) = "EXPIRED" Then
MailDest2 = Cells(iCounter, 29).Value
ElseIf MailDest2 <> "" And Cells(iCounter2, 22).Offset(0, -2) = "EXPIRED" Then
MailDest2 = MailDest2 & ";" & Cells(iCounter2, 29).Value
End If
End If
Next iCounter2
.To = MailDest2 generic e-mail
.CC = MailDest
.BCC = generic e-mail
If this is possible, would I need to repeat the With OutlookMailItem line, or can I simply add the additional code below the Next iCounter line?
Any and all help is greatly appreciated! Thank you very much!
Damian
I'm currently using the following VBA script to run an auto e-mail within an Excel workbook. However, currently the workbook needs to be open and a macro button needs to be clicked in order for the e-mail to be created and sent. Another thing is the e-mail is currently sending to multiple users that are retrieved from a specific column and placed within the BCC column in order for them to be unable to view all of the recipients.
I would like to modify the code to include a new column containing point of contact e-mail addresses, as well as have the macro built so the user can simply click a button within their desktop and have the e-mails created and sent whether the Excel file is open or closed. I would also like to be able to break up the e-mails to be individual e-mails sent to the vendor and point of contact for that vendor instead of multiple recipients all within the BCC section. Here is the code I'm currently using:
Sub Button2_Click()
Dim OutLookApp As Object
Dim OutLookMailItem As Object
Dim iCounter As Integer
Dim MailDest As String
Set OutLookApp = CreateObject("Outlook.application")
Set OutLookMailItem = OutLookApp.CreateItem(0)
Worksheets("Agreements").Activate
With OutLookMailItem
MailDest = ""
For iCounter = 2 To WorksheetFunction.CountA(Columns(28))
If Len(Cells(iCounter, 28).Offset(0, -1)) > 0 Then
If MailDest = "" And Cells(iCounter, 28).Offset(0, -1) = "EXPIRED" Then
MailDest = Cells(iCounter, 28).Value
ElseIf MailDest <> "" And Cells(iCounter, 28).Offset(0, -1) = "EXPIRED" Then
MailDest = MailDest & ";" & Cells(iCounter, 28).Value
End If
End If
Next iCounter
.To = generic e-mail
.BCC = MailDest
.Subject = "Insurance Verification"
.HTMLBody = "To Whom It May Concern,
" _
& "Please be advised the certificate of insurance we have on file has expired. " _
& "Please provide an updated certificate of insurance as quickly as possible. " _
& "We are currently out of compliance.
" _
& "Please email updated policy to e-mail address
" _
& "Thank You,
" & "John Doe
" _
& "Internal Auditor
" & "Central Region
" _
& "123 American Highway
" & "City, ST 11111
" _
& "Phone: 954-999-9999 Ext. 123-4567"
.Display '.Send
End With
Set OutLookMailItem = Nothing
Set OutLookApp = Nothing
End Sub
I was thinking perhaps I could possibly add this bit of code after the Next iCounter line in the existing code:
MailDest2 = ""
For iCounter2 = 2 To WorksheetFunction.CountB(Columns(29))
If Len(Cells(iCounter2, 29).Offset(0, -2)) > 0 Then
If MailDest2 = "" And Cells(iCounter2, 29).Offset(0, -2) = "EXPIRED" Then
MailDest2 = Cells(iCounter, 29).Value
ElseIf MailDest2 <> "" And Cells(iCounter2, 22).Offset(0, -2) = "EXPIRED" Then
MailDest2 = MailDest2 & ";" & Cells(iCounter2, 29).Value
End If
End If
Next iCounter2
.To = MailDest2 generic e-mail
.CC = MailDest
.BCC = generic e-mail
If this is possible, would I need to repeat the With OutlookMailItem line, or can I simply add the additional code below the Next iCounter line?
Any and all help is greatly appreciated! Thank you very much!
Damian