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

[arnel_101]

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

[Admin]

Hi Arnel,

Welcome to ExcelFox!!!

try this. Untested.


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/channel/UCnxwq2aGJRbjOo_MO54oaHA)
https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=UgwviLabd7r_3KpP6wh4AaABAg.9h5lFRmix1R9h78GftO_ iE (https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=UgwviLabd7r_3KpP6wh4AaABAg.9h5lFRmix1R9h78GftO_ iE)
https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=UgyG714V_k7odQMrTz14AaABAg.9h740K6COOA9h77HSGDH 4A (https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=UgyG714V_k7odQMrTz14AaABAg.9h740K6COOA9h77HSGDH 4A)
https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=UgyG714V_k7odQMrTz14AaABAg.9h740K6COOA9h76fafzc EJ (https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=UgyG714V_k7odQMrTz14AaABAg.9h740K6COOA9h76fafzc EJ)
https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=UgyG714V_k7odQMrTz14AaABAg.9h740K6COOA9h759YIjl aG (https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=UgyG714V_k7odQMrTz14AaABAg.9h740K6COOA9h759YIjl aG)
https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=UgyG714V_k7odQMrTz14AaABAg.9h740K6COOA9h74pjGcb Eq (https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=UgyG714V_k7odQMrTz14AaABAg.9h740K6COOA9h74pjGcb Eq)
https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=UgyG714V_k7odQMrTz14AaABAg (https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=UgyG714V_k7odQMrTz14AaABAg)
https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=UgzJJUDVv2Mb6YGkPYh4AaABAg.9h5uPRbWIZl9h7165DZd jg (https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=UgzJJUDVv2Mb6YGkPYh4AaABAg.9h5uPRbWIZl9h7165DZd jg)
https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA (https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA)


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=UgwviLabd7r_3KpP6wh4AaABAg.9h5lFRmix1R9h78GftO_ iE)
https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=UgyG714V_k7odQMrTz14AaABAg.9h740K6COOA9h77HSGDH 4A (https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=UgyG714V_k7odQMrTz14AaABAg.9h740K6COOA9h77HSGDH 4A)
https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=UgyG714V_k7odQMrTz14AaABAg.9h740K6COOA9h76fafzc EJ (https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=UgyG714V_k7odQMrTz14AaABAg.9h740K6COOA9h76fafzc EJ)
https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=UgyG714V_k7odQMrTz14AaABAg.9h740K6COOA9h759YIjl aG (https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=UgyG714V_k7odQMrTz14AaABAg.9h740K6COOA9h759YIjl aG)
https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=UgyG714V_k7odQMrTz14AaABAg.9h740K6COOA9h74pjGcb Eq (https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=UgyG714V_k7odQMrTz14AaABAg.9h740K6COOA9h74pjGcb Eq)
https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=UgyG714V_k7odQMrTz14AaABAg (https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=UgyG714V_k7odQMrTz14AaABAg)
https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=UgzJJUDVv2Mb6YGkPYh4AaABAg.9h5uPRbWIZl9h7165DZd jg (https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=UgzJJUDVv2Mb6YGkPYh4AaABAg.9h5uPRbWIZl9h7165DZd jg)
https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA (https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA)