Attaching Multiple Files to Email Document

[rigate2003]

Using VBA and Excel, I am trying to attach multiple documents to an email. The user will input the file search criteria, and any documents matching that file search criteria will be added as attachments. Currently, my macro perform a file search and open a new email in Outlook, but I'm not sure how to loop through and do multiple attachments. My code will need to do the following:

Loop through all files in a folder
If filename matches user inputted search then
attach file to an already created email document
end if
Check Next file

Any suggestions???
Thanks!!

 

[eblake]

Loop through the search results, every time it hits the file add the attachement with :
.Attachments.Add (myFileName)

 

[rigate2003]

Thanks for your response! I have the following code in place, but still get an error. Any suggestions? Do I need to declare/define "Filename" maybe? I appreciate the help!

i = 1
Do Until i = .FoundFiles.Count
OutMail.attachments.Add Filename
i = i + 1
Loop

 

[eblake]

Try this.

'Put this towards the top, outside the email building section
    Dim sFName As String
    Dim myDir As String
    myDir = "C:\Temp\" 'Set Dir to search
    ChDir (myDir) 'Change to that dir
    sFName = Dir(myDir & "Copy*.xls") 'Set Search spec


'Then in the email building section
                Do While Len(sFName) > 0
                    .Attachments.Add (myDir & "\" & sFName)
                    sFName = Dir
                Loop

 

[John_w]

Thanks for your response! I have the following code in place, but still get an error. Any suggestions? Do I need to declare/define "Filename" maybe? I appreciate the help!

i = 1
Do Until i = .FoundFiles.Count
OutMail.attachments.Add Filename
i = i + 1
Loop

Since you're using the FoundFiles object from Application.FileSearch, the line to attach each file should be:
OutMail.attachments.Add .FoundFiles(i)

Here's a complete working example:

Option Explicit

'Need reference to Microsoft Outlook Object Library

Sub Create_Email_With_Attachments()

    Dim olApp As Outlook.Application
    Dim olMail As Outlook.MailItem
    Dim fs As FileSearch
    Dim i As Integer
        
    Set olApp = CreateObject("Outlook.Application")
    Set olMail = olApp.CreateItem(olMailItem)
    
    With olMail
        .To = "recipient.email@address.com"  'CHANGE AS NECESSARY
        .Subject = "Test"   'CHANGE AS NECESSARY
        .Body = "Email body text"   'CHANGE AS NECESSARY
        .Display
    End With
    
    Set fs = Application.FileSearch
    With fs
        .LookIn = "F:\temp\excel\"   'CHANGE AS NECESSARY
        .Filename = "Test*"   'CHANGE AS NECESSARY
        If .Execute(SortBy:=msoSortByFileName, SortOrder:=msoSortOrderAscending) > 0 Then
            For i = 1 To .FoundFiles.Count
                olMail.Attachments.Add .FoundFiles(i)
            Next
            'olMail.Send  'UNCOMMENT TO SEND EMAIL
        Else
            MsgBox "No matching files found"
        End If
    End With

End Sub