I am working on a spreadsheet that will send emails and their attachments to any vendor that has a "yes" in row H. The file path/name of the attachment is stored in row G. I can get it to work if I just do one at a time, but once I try to use a loop to generate all emails and attachments at one time, it bombs out. If I remove the .Attachments.Add MailAttachments line in the macro, it generates all of the emails perfectly. Any help with the attachments issue would be greatly appreciated. The Macro is below:
Code:
Sub PC_Email()
Dim OutApp As Object
Dim OutMail As Object
Dim strbody As String
Dim MailAttachments As String
Sheets("Master").Select
Range("A1").Select
Application.ScreenUpdating = False
Set OutApp = CreateObject("Outlook.Application")
On Error GoTo cleanup
For Each cell In Columns("C").Cells
If cell.Value Like "?*@?*.?*" And _
LCase(Cells(cell.Row, "H").Value) = "yes" Then
With Application.ActiveSheet
MailAttachments = Cells(cell.Row, "G").Value
End With
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
strbody = "Hi " & Cells(cell.Row, "B") & "," & vbNewLine & vbNewLine & _
"The " & Cells(cell.Row, "A") & " ACH Remittance for " & Cells(cell.Row, "D") & " is attached." & vbNewLine & _
"Please let me know if you have any questions." & vbNewLine & vbNewLine & _
"Thanks," & vbNewLine & vbNewLine & _
"Accounts Payable" & vbNewLine & "Reily Foods"
.To = cell.Value
.Subject = Cells(cell.Row, "A") & " ACH Remittance"
.Body = strbody
.Attachments.Add MailAttachments
.Display 'Or use .Send
End With
On Error GoTo 0
Set OutMail = Nothing
End If
Next cell
cleanup:
Set OutApp = Nothing
Application.ScreenUpdating = True
End Sub
