Excel Macro to Send Multiple Emails w/ Attachments using Microsoft Outlook 2007

Hi ExcelFox,

I am trying to create an excel macro that will automatically send multiple emails with corresponding attachments to multiple recipients but my knowledge is not enough to run the codes. I decided to post it here because I believe somebody can help me or at least give me an idea on how to properly set the codes.

In this regard, I am wondering if there could be someone that can help me with this. I have attached the excel macro sample template that will give you enough data to come up with the output I needed. (Please, column A to G of 'Sheet1' will be the fields to be filled in with the NEW data).

Please let me know should you need any additional details. Any inputs and ideas from your end will be highly appreciated. Thanks!


Warmest regards,
Arnel

Hi Arnel,

Welcome to ExcelFox!!!

try this. Untested.

Code:

---

Option Explicit

Sub SendMassEmail()
   
    Dim i              As Long
    Dim j              As Long
    Dim InvNum          As String
    Dim Amount          As String
    Dim Accnt          As String
    Dim Attach(1 To 3)  As Variant
    Dim FilePath        As String
    Dim EBodyO          As String
    Dim EBodyN          As String
    Dim Location        As String
    Dim Subject        As String
    Dim SendTo          As String
    Dim SendCc          As String
    Dim Data
   
    Data = Sheet1.Range("a2").CurrentRegion.Value2
   
    Const Col_InvNum    As Long = 2
    Const Col_Amount    As Long = 3
    Const Col_FPath    As Long = 4
    Const Col_Accont    As Long = 8
    Const Col_SendTo    As Long = 9
    Const Col_SendCc    As Long = 10
    Const Col_Location  As Long = 11
   
    Const Txt_Invoice      As String = "replace_invoice_here"
    Const Txt_Amount        As String = "replace_amount_here"
    Const Txt_Accountant    As String = "Carmen Moran"
   
    EBodyO = Sheet6.Range("a1").Value
   
    For i = 2 To UBound(Data, 1)
        InvNum = Data(i, Col_InvNum)
        Amount = Format(Data(i, Col_Amount), "$ #,##.00")
        FilePath = Data(i, Col_FPath)
        If Not Right(FilePath, 1) = Application.PathSeparator Then FilePath = FilePath & Application.PathSeparator
        For j = 1 To 3
            Attach(j) = FilePath & Data(i, Col_FPath + j)
        Next
        Location = Data(i, Col_Location)
        Accnt = Data(i, Col_Accont)
        EBodyN = Replace(EBodyO, Txt_Invoice, InvNum, , , 1)
        EBodyN = Replace(EBodyN, Txt_Amount, Amount, , , 1)
        EBodyN = Replace(EBodyN, Txt_Accountant, Accnt, , , 1)
        Subject = InvNum & " from " & Location
        SendTo = Data(i, Col_SendTo)
        SendCc = Data(i, Col_SendCc)
       
        SendEmail Subject, EBodyN, SendTo, SendCc, Attach
       
    Next

    MsgBox "Complete"

End Sub

Sub SendEmail(Subject_Line As String, MailBody As String, SendTo As String, SendCc As String, ParamArray Attachs() As Variant)
   
    Dim olApp  As Outlook.Application
    Dim i      As Long
   
    Set olApp = CreateObject("Outlook.Application")

    Dim olMail As Outlook.MailItem
    Set olMail = olApp.CreateItem(olMailItem)
   
    olMail.To = SendTo
    olMail.CC = SendCc
    olMail.Subject = Subject_Line
    olMail.BodyFormat = olFormatHTML
    olMail.HTMLBody = MailBody
    For i = LBound(Attachs) To UBound(Attachs)
        olMail.Attachments.Add Attachs(i)
    Next
    olMail.Send
   
End Sub

---

https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA
https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=UgwviLabd7r_3KpP6wh4AaABAg. 9h5lFRmix1R9h78GftO_iE
https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=UgyG714V_k7odQMrTz14AaABAg. 9h740K6COOA9h77HSGDH4A
https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=UgyG714V_k7odQMrTz14AaABAg. 9h740K6COOA9h76fafzcEJ
https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=UgyG714V_k7odQMrTz14AaABAg. 9h740K6COOA9h759YIjlaG
https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=UgyG714V_k7odQMrTz14AaABAg. 9h740K6COOA9h74pjGcbEq
https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=UgyG714V_k7odQMrTz14AaABAg
https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=UgzJJUDVv2Mb6YGkPYh4AaABAg. 9h5uPRbWIZl9h7165DZdjg
https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA


https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA
https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=UgwviLabd7r_3KpP6wh4AaABAg. 9h5lFRmix1R9h78GftO_iE
https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=UgyG714V_k7odQMrTz14AaABAg. 9h740K6COOA9h77HSGDH4A
https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=UgyG714V_k7odQMrTz14AaABAg. 9h740K6COOA9h76fafzcEJ
https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=UgyG714V_k7odQMrTz14AaABAg. 9h740K6COOA9h759YIjlaG
https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=UgyG714V_k7odQMrTz14AaABAg. 9h740K6COOA9h74pjGcbEq
https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=UgyG714V_k7odQMrTz14AaABAg
https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=UgzJJUDVv2Mb6YGkPYh4AaABAg. 9h5uPRbWIZl9h7165DZdjg
https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA