Hello,
I've written the following code for sending emails with individual attachments. The code cannot execute the attachment part. Without it, the code works fine.
Could you please have a look and tell me how to modify the code in order for the attachments to work.
Sub Send_Bulk_Email()
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets("name")
Dim i As Integer
Dim OA As Object
Dim msg As Object
Dim AttachmentFolder As String
Dim AttachmentFile As String = "C:\Users\jenny.abbott\Documents\"
Set OA = CreateObject("Outlook.application")
Dim lastRow As Integer
lastRow = Application.CountA(ws.Range("A:A"))
For i = 2 To lastRow
Set msg = OA.createItem(0)
msg.To = ws.Range("A" & i).Value
msg.CC = ws.Range("B" & i).Value
msg.BCC = ws.Range("C" & i).Value
msg.Subject = ws.Range("D" & i).Value
msg.Body = ws.Range("E" & i).Value
If ws.Range("F" & i).Value <> "" Then
msg.attachments.Add.ws.Range("F" & i).Value
End If
msg.display
ws.Range("G" & i).Value = "Sent"
Next i
MsgBox "Successfully Sent"
End Sub
I've written the following code for sending emails with individual attachments. The code cannot execute the attachment part. Without it, the code works fine.
Could you please have a look and tell me how to modify the code in order for the attachments to work.
Sub Send_Bulk_Email()
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets("name")
Dim i As Integer
Dim OA As Object
Dim msg As Object
Dim AttachmentFolder As String
Dim AttachmentFile As String = "C:\Users\jenny.abbott\Documents\"
Set OA = CreateObject("Outlook.application")
Dim lastRow As Integer
lastRow = Application.CountA(ws.Range("A:A"))
For i = 2 To lastRow
Set msg = OA.createItem(0)
msg.To = ws.Range("A" & i).Value
msg.CC = ws.Range("B" & i).Value
msg.BCC = ws.Range("C" & i).Value
msg.Subject = ws.Range("D" & i).Value
msg.Body = ws.Range("E" & i).Value
If ws.Range("F" & i).Value <> "" Then
msg.attachments.Add.ws.Range("F" & i).Value
End If
msg.display
ws.Range("G" & i).Value = "Sent"
Next i
MsgBox "Successfully Sent"
End Sub