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:
<code>
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 = "John_Doe@whatever.com"
.BCC = MailDest
.Subject = "Insurance Verification"
.HTMLBody = "To Whom It May Concern,<p>" _
& "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.<p>" _
& "Please email updated policy to John_Doe@whatever.com<p>" _
& "Thank You,<p>" & "<b>John Doe</b><br>" _
& "Internal Auditor<br>" & "Central Region<br>" _
& "123 American Highway<br>" & "City, ST 11111<br>" _
& "Phone: 954-999-9999 Ext. 123-4567"
.Display '.Send
End With
Set OutLookMailItem = Nothing
Set OutLookApp = Nothing
End Sub
</code>
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:
<code>
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 = "John_Doe@whatever.com"
.BCC = MailDest
.Subject = "Insurance Verification"
.HTMLBody = "To Whom It May Concern,<p>" _
& "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.<p>" _
& "Please email updated policy to John_Doe@whatever.com<p>" _
& "Thank You,<p>" & "<b>John Doe</b><br>" _
& "Internal Auditor<br>" & "Central Region<br>" _
& "123 American Highway<br>" & "City, ST 11111<br>" _
& "Phone: 954-999-9999 Ext. 123-4567"
.Display '.Send
End With
Set OutLookMailItem = Nothing
Set OutLookApp = Nothing
End Sub
</code>
Any and all help is greatly appreciated! Thank you very much!
Damian
