Hello all,
I'm attempting to have automatic emails be sent out with an attachment, however, when I attempt to run the code I receive a Run-time error. I've changed my code around, and I'm unsure what object missing. I essentially want all stores with a status of open that doesn't currently have a POC name or POC email within columns G & H. If those two criteria are met, then an automatic email will be created using the email addresses within columns S & U. Unsure what I'm missing. The code I'm using is below:
All help is greatly appreciated!!! Thank you!
D
I'm attempting to have automatic emails be sent out with an attachment, however, when I attempt to run the code I receive a Run-time error. I've changed my code around, and I'm unsure what object missing. I essentially want all stores with a status of open that doesn't currently have a POC name or POC email within columns G & H. If those two criteria are met, then an automatic email will be created using the email addresses within columns S & U. Unsure what I'm missing. The code I'm using is below:
VBA Code:
Private Sub CommandButton1_Click()
Dim OutLookApp As Object
Dim OutLookMail As Object
Dim cell As Range
Set OutLookApp = CreateObject("Outlook.application")
Set OutLookMail = OutLookApp.CreateItem(0)
Worksheets("AllData").Activate
For Each cell In Columns("E").Cells.SpecialCells(xlCellTypeConstants)
If cell.Value = "Open" And _
LCase(Cells(cell.Row, "G").Value) = "" Then
With OutMail
.To = Cells(cell.Row, "S").Value
.CC = Cells(cell.Row, "U").Value
.BCC = "John_Doe@generic.com; John_Doe2@generic.com;"
.Subject = "Missing store POC"
.HTMLBody = "To Whom It May Concern,<p>" _
& "Please be advised the store POC information is currently missing for stores in your area. " _
& "If available, please provide current store POC information in order" _
& "for automatic emails to be sent to the correct store POC.<p>" _
& "Please note: If the store POC field remains empty, all emails will be" _
& "directed to ROMs and FMMs.<p>" _
& "Please email updated documentation to John_Doe@generic.com<p>"
.Display
'.Send
End With
.Attachments.Add ActiveWorkbook.FullName
Set OutLookMail = Nothing
End If
Next cell
'End If
'Next iCounter
cleanup:
Set OutLookApp = Nothing
Application.ScreenUpdating = True
End Sub
All help is greatly appreciated!!! Thank you!
D