Sending emails to multiple recipients with different file names via VBA & Excel

merxi7

New Member
Joined
Jul 18, 2021
Messages
5
Office Version
  1. 2010
Platform
  1. Windows
Hi Excel Experts,

I've managed to get the below VBA working from an old (2019) thread. It creates emails to recipients for each row in a spreadsheet, customizes the email content (with the recipients name) and also attaches a file based on a file path in column E of the sheet. However, it attaches all the files in the folder. What I need is to attach only the files base on the filename in Column F.
I am very new to VBA, tried to change the code of the filename, but no luck.
Thanking you in advance for any response.

Sub SendMail()

ActiveWorkbook.RefreshAll

Dim objOutlook As Object
Dim objMail As Object
Dim Attachments As Object
Dim ws As Worksheet
Dim fileName As String


Set objOutlook = CreateObject("Outlook.Application")
Set ws = ActiveSheet

For Each cell In ws.Range("A2", ws.Cells(Rows.Count, "A").End(xlUp))


Set objMail = objOutlook.CreateItem(0)


With objMail
.To = cell.Value
.CC = cell.Offset(0, 1).Value
.Subject = cell.Offset(0, 2).Value
.Body = cell.Offset(0, 3).Value
fileName = Dir(cell.Offset(0, 4).Value & "\*")
While fileName <> vbNullString
.Attachments.Add cell.Offset(0, 4).Value & "\" & fileName
fileName = Dir()
Wend
.Display
End With

Set objMail = Nothing
Next cell

Set ws = Nothing
Set objOutlook = Nothing

End Sub
 

Attachments

  • Excel template.JPG
    Excel template.JPG
    29 KB · Views: 12

Excel Facts

Did you know Excel offers Filter by Selection?
Add the AutoFilter icon to the Quick Access Toolbar. Select a cell containing Apple, click AutoFilter, and you will get all rows with Apple

Sequoyah

Board Regular
Joined
Mar 26, 2017
Messages
60
Hi merxi7,
I suggest you to enter in column E the complete path with the name of the attachment including the extension (e.g. C:\My Files\Customer 1.pdf) then use the following code
VBA Code:
Sub SendMail2()
    
    ActiveWorkbook.RefreshAll
    
    Dim objOutlook As Object
    Dim objMail As Object
    Dim Attachments As Object
    Dim ws As Worksheet
    Dim fileName As String
    Dim cell As Range
    
    Set objOutlook = CreateObject("Outlook.Application")
    Set ws = ActiveSheet
    
    For Each cell In ws.Range("A2", ws.Cells(Rows.Count, "A").End(xlUp))
        
        Set objMail = objOutlook.CreateItem(0)
        fileName = cell.Offset(0, 4).Value
        
        With objMail
            .To = cell.Value
            .CC = cell.Offset(0, 1).Value
            .Subject = cell.Offset(0, 2).Value
            .Body = cell.Offset(0, 3).Value
            .Attachments.Add fileName
            .Display
        End With
        
        Set objMail = Nothing
    Next cell
    
    Set ws = Nothing
    Set objOutlook = Nothing
    
End Sub
 

merxi7

New Member
Joined
Jul 18, 2021
Messages
5
Office Version
  1. 2010
Platform
  1. Windows
Hi Sequoyah, thanks for your input. However, your the above will take only pdf attachment.
Is it possible to take both pdf and xlsx formats? The file name is the same for both formats
 

Sequoyah

Board Regular
Joined
Mar 26, 2017
Messages
60
Hi merxi7,
The attachment must always be indicated with the full path and the name plus the extension. Do you always have to attach both types of files to your mail? In this case write in your cell the file name without the extension and then add it in the code, as in the following example

VBA Code:
Sub SendMail2()
    
    ActiveWorkbook.RefreshAll
    
    Dim objOutlook As Object
    Dim objMail As Object
    Dim Attachments As Object
    Dim ws As Worksheet
    Dim fileName As String
    Dim cell As Range
    
    Set objOutlook = CreateObject("Outlook.Application")
    Set ws = ActiveSheet
    
    For Each cell In ws.Range("A2", ws.Cells(Rows.Count, "A").End(xlUp))
        
        Set objMail = objOutlook.CreateItem(0)
        fileName = cell.Offset(0, 4).Value
        
        With objMail
            .To = cell.Value
            .CC = cell.Offset(0, 1).Value
            .Subject = cell.Offset(0, 2).Value
            .Body = cell.Offset(0, 3).Value
            .Attachments.Add fileName & ".pdf"
        .Attachments.Add fileName & ".xlsx"
            .Display
        End With
        
        Set objMail = Nothing
    Next cell
    
    Set ws = Nothing
    Set objOutlook = Nothing
    
End Sub
 

merxi7

New Member
Joined
Jul 18, 2021
Messages
5
Office Version
  1. 2010
Platform
  1. Windows

ADVERTISEMENT

Hey, I was able to figure out the attachments issue.
My problem now is how can I use the non-default account for sending out emails?
I have 2 accounts in Outlook, and I tried the below code but is not working. It is still taking up the 1st account from outlook :(

Sub SendMail2()

ActiveWorkbook.RefreshAll

Dim objOutlook As Object
Dim objMail As Object
Dim Attachments As Object
Dim ws As Worksheet
Dim Invoice As String, Consumption As String
Dim cell As Range

Set objOutlook = CreateObject("Outlook.Application")
Set ws = ActiveSheet

For Each cell In ws.Range("A2", ws.Cells(Rows.Count, "A").End(xlUp))

Set objMail = objOutlook.CreateItem(0)

Path = "C:\Invoice Export\"
Invoice = Path & cell.Offset(0, 5).Value & ".pdf"
Consumption = Path & cell.Offset(0, 5).Value & ".xlsx"

With objMail
.To = cell.Value
.CC = cell.Offset(0, 1).Value
.Subject = cell.Offset(0, 2).Value
.Body = cell.Offset(0, 3).Value
.Attachments.Add Invoice
.Attachments.Add Consumption
.SendUsingAccount = .Session.Accounts.Item(2)
.Display/Send
End With

Set objMail = Nothing
Next cell

Set ws = Nothing
Set objOutlook = Nothing

End Sub
 

Sequoyah

Board Regular
Joined
Mar 26, 2017
Messages
60
Hi, change the line
VBA Code:
.SendUsingAccount = .Session.Accounts.Item(2)
with
Code:
Set .SendUsingAccount = objMail.Session.Accounts.Item(2)
 

merxi7

New Member
Joined
Jul 18, 2021
Messages
5
Office Version
  1. 2010
Platform
  1. Windows
Hi, change the line
VBA Code:
.SendUsingAccount = .Session.Accounts.Item(2)
with
Code:
Set .SendUsingAccount = objMail.Session.Accounts.Item(2)
Awesome. Thank you so much
 

Forum statistics

Threads
1,141,062
Messages
5,704,057
Members
421,325
Latest member
tapete86

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top