Results 1 to 2 of 2

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

  1. #1
    Junior Member
    Join Date
    Mar 2017
    Posts
    2
    Rep Power
    0

    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
    Attached Files Attached Files

  2. #2
    Administrator Admin's Avatar
    Join Date
    Mar 2011
    Posts
    1,123
    Rep Power
    10
    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
    Last edited by DocAElstein; 07-10-2023 at 07:09 PM.
    Cheers !

    Excel Range to BBCode Table
    Use Social Networking Tools If You Like the Answers !

    Message to Cross Posters

    @ Home - Office 2010/2013/2016 on Win 10 (64 bit); @ Work - Office 2016 on Win 10 (64 bit)

Similar Threads

  1. Replies: 3
    Last Post: 02-09-2019, 08:44 AM
  2. Replies: 9
    Last Post: 10-17-2013, 05:09 PM
  3. Replies: 6
    Last Post: 06-05-2013, 11:33 PM
  4. Replies: 2
    Last Post: 01-07-2013, 04:34 PM
  5. Replies: 7
    Last Post: 05-09-2012, 11:34 PM

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •