Hello,
I have a macro in place at work that currently sends a file to only one recipient. I have been asked to start sending the same file to multiple people. My current macro can only send to one recipient at a time, but I am uncertain as to how to add more to the list. For example, I want one email with an attachment sent to three people rather than sending the email three times to each individual person.
I am attaching my current macro code. I attempted to add multiple recipients in column B, but that didn't seem to work. I am kind of stumped. I am not sure how to add this code into a code box.
I have a macro in place at work that currently sends a file to only one recipient. I have been asked to start sending the same file to multiple people. My current macro can only send to one recipient at a time, but I am uncertain as to how to add more to the list. For example, I want one email with an attachment sent to three people rather than sending the email three times to each individual person.
I am attaching my current macro code. I attempted to add multiple recipients in column B, but that didn't seem to work. I am kind of stumped. I am not sure how to add this code into a code box.
Code:
Sub Macro2()
'
' Macro2 Macro
'
Dim Response As VbMsgBoxResult
Response = MsgBox("Are you sure you want to send the emails?", vbQuestion + vbYesNo)
If Response = vbNo Then Exit Sub
Range("B5").Select
Do
Dim aOutlook As Outlook.Application, aEmail As Outlook.MailItem
Set aOutlook = GetObject(, "Outlook.Application")
If aOutlook Is Nothing Then Set aOutlook = New Outlook.Application
Set aEmail = aOutlook.CreateItem(olMailItem)
aEmail.Subject = ActiveCell.Offset(0, 1)
aEmail.Body = Range("E5") & Chr(13) & Chr(13) & Range("E6") & Chr(13) & Chr(13) & Range("E7") & Chr(13) & Chr(13) & Range("E8") & Chr(13) & Range("E9") & Chr(13) & Range("E10") & Chr(13) & Range("E11") & Chr(13) & Range("E12")
aEmail.Recipients.Add ActiveCell.Text
aEmail.Attachments.Add ActiveCell.Offset(0, 2).Text
aEmail.Send
ActiveCell.Offset(1, 0).Select
Loop Until IsEmpty(ActiveCell.Offset(0, 0))
MsgBox "All emails have been sent", vbInformation
'
End Sub
Last edited by a moderator: