How to attach all files in folder to an email - vba code

Question

I have the following code in vba, all works well but i need to change to attach all files in selected folder (the way it is now i have to write the name of said attachment). Unfortunately i'm a noob when it comes to vba programming.

Sub Send_Files()

Dim OutApp As Object
Dim OutMail As Object
Dim sh As Worksheet
Dim cell As Range
Dim FileCell As Range
Dim rng As Range

With Application
    .EnableEvents = False
    .ScreenUpdating = False
End With

Set sh = Sheets("Sheet1")

Set OutApp = CreateObject("Outlook.Application")

For Each cell In sh.Columns("A").Cells.SpecialCells(xlCellTypeConstants)

    Set rng = sh.Cells(cell.Row, 1).Range("D1:Z1")

    If cell.Value Like "?*@?*.?*" And _
    Application.WorksheetFunction.CountA(rng) > 0 Then
        Set OutMail = OutApp.CreateItem(0)

        With OutMail
            .To = sh.Cells(cell.Row, 1).Value
            .CC = sh.Cells(cell.Row, 2).Value
            .Subject = "Decont UTA"
            .Body = sh.Cells(cell.Row, 3).Value

            For Each FileCell In rng.SpecialCells(xlCellTypeConstants)
                If Trim(FileCell.Value) <> "" Then
                    If Dir(FileCell.Value) <> "" Then
                        .Attachments.Add FileCell.Value
                    End If
                End If
            Next FileCell

            .Send 'Or use .Display/Send
        End With

        Set OutMail = Nothing
    End If
Next cell

Set OutApp = Nothing

With Application
    .EnableEvents = True
    .ScreenUpdating = True
End With

End Sub

https://www.bing.com/search?q=get+all+files+in+folder+vba&src=IE-TopResult&FORM=IETR02&conversationid= — Nathan_Sav, Jan 16 '19 at 14:20
Please share what you have done so far! You will get a better answer if you show what you have tried and what your problem is. — Sam, Jan 16 '19 at 14:23
@ Nathan i know it can be done, a found myself several examples but i couldn't adapt it to my case (to the code i already have). @Sam My problem now is that i want to change the code that it will attach all files in the specified directory (example, i have 300 email to send 2 times a month, each with attachments, attachments that have different names every time ) — yujy, Jan 16 '19 at 14:42
@yujy so why not use the example to loop the files and adjust your `.Attachments.Add ` accordingly? — Nathan_Sav, Jan 16 '19 at 14:42
@Nathan_Sav, i have no idea how to do that. I've been trying the last 2 days to do that, but it wont work, like i said i'm new at vba. — yujy, Jan 16 '19 at 14:57
https://stackoverflow.com/questions/10380312/loop-through-files-in-a-folder-using-vba hint change `Debug.Print StrFile` to your attachement adding code and add this functionality to your existing code. — Nathan_Sav, Jan 16 '19 at 15:00
@Nathan_sav maybe i wasn't clear sry for that, the a.m. code sends an email for every line: A2 - email address; B2 - CC address; C2 - email name; D2 through Z2 attachments. The attachments i have to write the directory + name of said attachment (invoice.pdf for example; if i have 20 attachments i have to whrite 20 addresses). I just want to change so that the email attaches all files in said directory. — yujy, Jan 16 '19 at 15:17
`For Each FileCell In rng.SpecialCells(xlCellTypeConstants)` you need to change your code `rng.SpecialCells(xlCellTypeConstants)` instead of this, loop every cell in the last column, so `rng.column(rng.columns.count-1).SpecialCells(xlCellTypeConstants)` may not need the -1, cant test at the minute — Nathan_Sav, Jan 16 '19 at 15:19
It doesn't work, error Compile Error, Wrong number of arguments or invalid property assigment — yujy, Jan 16 '19 at 15:35
What column will your Attachment Path be? Example https://stackoverflow.com/a/38303646/4539709 — 0m3r, Jan 16 '19 at 19:17

score 1 · Answer 1 · 2019-01-16T15:35:50.563

General approach to find specific files in a folder and optionally in subfolders.

'******************************************************************
'* Find files in current folder and optionally in subfolders
'*
Option Explicit

Const ROOTFOLDER = "C:\Test"  'Change as desired
Const EXTENSION = "txt"       'Change as desired

Const FILES = "*." & EXTENSION

Dim g_FolderCount As Integer
Dim g_FileCount As Integer
'**********************************
'* Test code only
'*
Sub Test()
    Dim Path As String

    g_FileCount = 0
    g_FolderCount = 0
    Path = ROOTFOLDER
    GetSubFolders Path, True
    Debug.Print "Number of folders: " & g_FolderCount & ". Number of files: " & g_FileCount
End Sub
'****************************************************************
'* Recursive sub to find path and files
'*
Sub GetSubFolders(Path As String, subFolders As Boolean)
    Dim FSO As Object           'Late binding: Scripting.FileSystemObject
    Dim myFolder As Object      'Late binding: Folder
    Dim mySubFolder As Object

    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set myFolder = FSO.GetFolder(Path)
    If subFolders Then
        If myFolder.subFolders.Count <> 0 Then
            ProcessFiles Path                             'First branch (root)
            For Each mySubFolder In myFolder.subFolders
                g_FolderCount = g_FolderCount + 1
                GetSubFolders mySubFolder.Path, subFolders
            Next
        Else  'No more subfolders in Path, process files in current path
            ProcessFiles Path
        End If
    Else 'No subdirectories, process current only
       ProcessFiles Path
    End If
End Sub
'*********************************************
'* Callback from GetSubFolders
'* Process files in the found folder
'*
Sub ProcessFiles(ByVal Path As String)
    Dim theFilePattern As String
    Dim theFile As String

    Path = Path & "\"
    theFilePattern = Path & FILES
    theFile = Dir(theFilePattern)
    While theFile <> ""    'Attach file with your own code from here
        g_FileCount = g_FileCount + 1
        Debug.Print Path & theFile
        theFile = Dir()    ' Next file if any
    Wend
End Sub

I don't see how this helps me, a just needed to add all files in a specified directory to an email (300 different mail each with 300 different directories, each directory with many different files - mostly pdf), i can't even begin to add yr. code to my existing code. — yujy, Jan 16 '19 at 15:40
Did you read my comment **Attach file with your own code from here**? There you make a call to a sub that attach the found file to your email: ***.Attachments.Add Path & theFile*** — , Jan 16 '19 at 15:47
I tried but i couldn't make it work. Do i have to make 4 different macro's?!, I found a way to retrieve all named attachments from excel as a work around (therefore i don;t need to edit my original code). Sorry for wasting yr. time, vba is beyond my capability. — yujy, Jan 16 '19 at 17:35

score 0 · Answer 2 · edited Mar 24 '23 at 09:37

Sub Send_Files()
    Dim OutApp As Object
    Dim OutMail As Object
    Dim sh As Worksheet
    Dim cell As Range
    Dim FileCell As Range
    Dim rng As Range
    Dim FolderPath As String
    Dim FileName As String

    With Application
        .EnableEvents = False
        .ScreenUpdating = False
    End With

    Set sh = Sheets("Sheet1")

    Set OutApp = CreateObject("Outlook.Application")

    For Each cell In sh.Columns("A").Cells.SpecialCells(xlCellTypeConstants)

        Set rng = sh.Cells(cell.Row, 1).Range("D1:Z1")
        FolderPath = sh.Cells(cell.Row, 1).Offset(0, 1).Value 'get folder path from column B

        If cell.Value Like "?*@?*.?*" And _
        Application.WorksheetFunction.CountA(rng) > 0 Then
            Set OutMail = OutApp.CreateItem(0)

            With OutMail
                .To = sh.Cells(cell.Row, 1).Value
                .CC = sh.Cells(cell.Row, 2).Value
                .Subject = "Decont UTA"
                .Body = sh.Cells(cell.Row, 3).Value

                'Attach all files in the folder
                FileName = Dir(FolderPath & "\*.*")
                Do While FileName <> ""
                    .Attachments.Add FolderPath & "\" & FileName
                    FileName = Dir()
                Loop

                .Send 'Or use .Display/Send
            End With

            Set OutMail = Nothing
        End If
    Next cell

    Set OutApp = Nothing

    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With
End Sub

As it’s currently written, your answer is unclear. Please [edit] to add additional details that will help others understand how this addresses the question asked. You can find more information on how to write good answers [in the help center](/help/how-to-answer). — Community, Mar 24 '23 at 09:37

How to attach all files in folder to an email - vba code

2 Answers2

Linked