VBA attach multiple files to email from folder

ChloeSpurge

New Member
Joined
May 5, 2021
Messages
25
Office Version
  1. 2016
Platform
  1. Windows
Hi All,

I have this code that creates emails for each row in my table (a different customer) then adds a file, subject etc. However, it only works when the customer has one file, and some emails need up to 10 or more files attaching. I've put the file names in column B separated by commas, anyway to get the code to run through and add all the files?
1660923448738.png


1660923200720.png



Thanks for any help
Chloe :)
 

Excel Facts

Format cells as date
Select range and press Ctrl+Shift+3 to format cells as date. (Shift 3 is the # sign which sort of looks like a small calendar).

Sequoyah

Board Regular
Joined
Mar 26, 2017
Messages
128
Office Version
  1. 365
Platform
  1. Windows
Hi Chloe, here's my suggestion
VBA Code:
Sub Test_emails()
'https://www.mrexcel.com/board/threads/vba-attach-multiple-files-to-email-from-folder.1214138/

Dim EApp As Object
Set EApp = CreateObject("Outlook.Application")
Dim EItem As Object
Dim path As String, LBody As String, MyFile As String

Dim Attachments() As String
Dim i As Integer

path = "C:\Users\chloe\Contractor\IA\P318 File V2\P318 File\"

Dim RList As Range
Set RList = Range("A2", Range("A2").End(xlDown))
Dim R As Range
For Each R In RList
Set EItem = EApp.CreateItem(0)

With EItem
.To = R.Offset(0, 2)
.Subject = "3183 Week " & R.Offset(0, 4) & " - " & R.Offset(0, 3)
MyFile = R.Offset(0, 1)

If MyFile <> "" Then
    Attachments = Split(MyFile, ",")
    For i = LBound(Attachments) To UBound(Attachments)
        If Attachments(i) <> "" Then
            .Attachments.Add path & Trim(Attachments(i))
        End If
    Next i
End If

LBody = "Hi," & vbNewLine & vbNewLine _
& "Please find the 3183 for your allocated duties for week " & R.Offset(0, 4) & " attached." _
& vbNewLine & vbNewLine & "Many thanks"
.Display
End With
Next R
Set EApp = Nothing
Set EItem = Nothing
End Sub
 
Upvote 0
Solution

ChloeSpurge

New Member
Joined
May 5, 2021
Messages
25
Office Version
  1. 2016
Platform
  1. Windows
Great thank you it works! Only one thing, when there's just one customer in the table, it creates a lot of empty emails, I'm guessing its something to do with the Range("A2", Range("A2").End(xlDown)), is there a way to stop this?
 
Upvote 0

Sequoyah

Board Regular
Joined
Mar 26, 2017
Messages
128
Office Version
  1. 365
Platform
  1. Windows
Hi Chloe,
thank you for the feedback, edit the line of code as follows
VBA Code:
Set RList = Range("A2", Range("A1").End(xlDown))

PS I believe you will have a better chance of getting help by posting the code instead of an image ;)
 
Upvote 0

ChloeSpurge

New Member
Joined
May 5, 2021
Messages
25
Office Version
  1. 2016
Platform
  1. Windows
Hi Chloe,
thank you for the feedback, edit the line of code as follows
VBA Code:
Set RList = Range("A2", Range("A1").End(xlDown))

PS I believe you will have a better chance of getting help by posting the code instead of an image ;)
Great thanks again it works perfectly!

good plan, will do in future ;)

Chloe
 
Upvote 0

ChloeSpurge

New Member
Joined
May 5, 2021
Messages
25
Office Version
  1. 2016
Platform
  1. Windows
Hi Chloe,
thank you for the feedback, edit the line of code as follows
VBA Code:
Set RList = Range("A2", Range("A1").End(xlDown))

PS I believe you will have a better chance of getting help by posting the code instead of an image ;)
Hi, its me again. Is there a way to get the VBA to produce a pop up if a file that needs to be attached cannot be found in the folder? Then continuous as normal after? At the moment the whole macro stops :( Thanks Again
 
Upvote 0

ChloeSpurge

New Member
Joined
May 5, 2021
Messages
25
Office Version
  1. 2016
Platform
  1. Windows
Great thanks again it works perfectly!

good plan, will do in future ;)

Chloe
Hi, the body of the email doesn't seem to be added anymore? any reasons why?

Thanks
Chloe
 
Upvote 0

Sequoyah

Board Regular
Joined
Mar 26, 2017
Messages
128
Office Version
  1. 365
Platform
  1. Windows
Hi Chloe,
it's my fault - .Body inadvertently became LBody.
I added the code to verify the existence of the file to attach, otherwise an error message appears and the macro stops.

VBA Code:
Sub Test_emails2()
'https://www.mrexcel.com/board/threads/vba-attach-multiple-files-to-email-from-folder.1214138/

Dim EApp As Object
Set EApp = CreateObject("Outlook.Application")
Dim EItem As Object
Dim path As String, LBody As String, MyFile As String

Dim Attachments() As String, ExistFile() As String
Dim i As Integer, j As Integer

path = "C:\Users\chloe\Contractor\IA\P318 File V2\P318 File\"

Dim RList As Range
Set RList = Range("A2", Range("A1").End(xlDown))
Dim R As Range

For Each R In RList
MyFile = R.Offset(0, 1)
    ExistFile = Split(MyFile, ",")
    For j = LBound(ExistFile) To UBound(ExistFile)
        If Dir(path & ExistFile(j)) = "" Then
            MsgBox (path & (ExistFile(j)) & " doesn't exist")
        
        Exit Sub
        End If
    Next j

Next R

For Each R In RList
Set EItem = EApp.CreateItem(0)

With EItem
.To = R.Offset(0, 2)
.Subject = "3183 Week " & R.Offset(0, 4) & " - " & R.Offset(0, 3)
MyFile = R.Offset(0, 1)

If MyFile <> "" Then
    Attachments = Split(MyFile, ",")
    For i = LBound(Attachments) To UBound(Attachments)
        If Attachments(i) <> "" Then
            .Attachments.Add path & Trim(Attachments(i))
        End If
    Next i
End If

.Body = "Hi," & vbNewLine & vbNewLine _
& "Please find the 3183 for your allocated duties for week " & R.Offset(0, 4) & " attached." _
& vbNewLine & vbNewLine & "Many thanks"
.Display
End With
Next R
Set EApp = Nothing
Set EItem = Nothing
End Sub
 
Upvote 0

ChloeSpurge

New Member
Joined
May 5, 2021
Messages
25
Office Version
  1. 2016
Platform
  1. Windows
Hi Chloe,
it's my fault - .Body inadvertently became LBody.
I added the code to verify the existence of the file to attach, otherwise an error message appears and the macro stops.

VBA Code:
Sub Test_emails2()
'https://www.mrexcel.com/board/threads/vba-attach-multiple-files-to-email-from-folder.1214138/

Dim EApp As Object
Set EApp = CreateObject("Outlook.Application")
Dim EItem As Object
Dim path As String, LBody As String, MyFile As String

Dim Attachments() As String, ExistFile() As String
Dim i As Integer, j As Integer

path = "C:\Users\chloe\Contractor\IA\P318 File V2\P318 File\"

Dim RList As Range
Set RList = Range("A2", Range("A1").End(xlDown))
Dim R As Range

For Each R In RList
MyFile = R.Offset(0, 1)
    ExistFile = Split(MyFile, ",")
    For j = LBound(ExistFile) To UBound(ExistFile)
        If Dir(path & ExistFile(j)) = "" Then
            MsgBox (path & (ExistFile(j)) & " doesn't exist")
       
        Exit Sub
        End If
    Next j

Next R

For Each R In RList
Set EItem = EApp.CreateItem(0)

With EItem
.To = R.Offset(0, 2)
.Subject = "3183 Week " & R.Offset(0, 4) & " - " & R.Offset(0, 3)
MyFile = R.Offset(0, 1)

If MyFile <> "" Then
    Attachments = Split(MyFile, ",")
    For i = LBound(Attachments) To UBound(Attachments)
        If Attachments(i) <> "" Then
            .Attachments.Add path & Trim(Attachments(i))
        End If
    Next i
End If

.Body = "Hi," & vbNewLine & vbNewLine _
& "Please find the 3183 for your allocated duties for week " & R.Offset(0, 4) & " attached." _
& vbNewLine & vbNewLine & "Many thanks"
.Display
End With
Next R
Set EApp = Nothing
Set EItem = Nothing
End Sub
Great thank you :)
 
Upvote 0

Forum statistics

Threads
1,187,139
Messages
5,961,783
Members
438,563
Latest member
Ron Gluck

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