PDA

View Full Version : VBA script to auto send e-mail using closed Excel Workbook



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