VBA to add all files in a folder to an email

[counihan3]

I am trying to write a macro that will take all of the .xls files in a folder then create and add them to an email. I have been able to get a list of all of the files and I have been able to generate an email with an attachment but I have not been able to do both. Here is my code"

Sub asd()
Dim objol As New Outlook.Application
Dim objmail As MailItem
Set objol = New Outlook.Application
Set objmail = objol.CreateItem(olMailItem)

Dim fso As Object
Dim strName As String
Dim strArr(1 To 65536, 1 To 1) As String, i As Long
Dim testa As String

Const strDir As String = "\\sales-a\current tickets\Mass Macro"
Const searchTerm As String = ""

Let strName = Dir$(strDir & "\*" & searchTerm & "*.xls")
Do While strName <> vbNullString
    Let i = i + 1
    Let strArr(i, 1) = strDir & "\" & strName
    Let strName = Dir$()
    Let testa = (strDir & "\" & strName) & "; " & testa
Loop
Set fso = CreateObject("Scripting.FileSystemObject")
Set fso = Nothing
If i > 0 Then
'    MsgBox testa
End If

With objmail
.To = "me"
.CC = ""
.Subject = "Ticket " & Today & " " & Name
.Body = MyValue
.NoAging = True
    .Attachments.Add testa
.Display
End With
Set objmail = Nothing
Set objol = Nothing
End Sub

 

[GTO]

I am trying to write a macro that will take all of the .xls files in a folder then create and add them to an email. I have been able to get a list of all of the files and I have been able to generate an email with an attachment but I have not been able to do both. Here is my code"

Greetings counihan,

Not sure about adding an array of attachments, but would this simple/un-pretty example help? I tested, and appears to be glitch-free...

Option Explicit
Sub exAddAttachments()
Dim objol As Object
Dim objmail As Object
Dim objFolder As Object
Dim strFolder As String
Dim fso As Object
Dim fsFolder As Object
Dim fsFile As Object
'---------------------------------------------------------------------------------------//
    
    '// Create a folder browser.  Note:  You can change the last arg (the Empty) to a   //
    '// string where you want the folder browser to start in, such as: ThisWorkbook.Path//
    Set objFolder = CreateObject("Shell.Application"). _
                        BrowseForFolder( _
                            0, "Select the folder that the workbooks are in.", 0, Empty)
    
    On Error GoTo errhndl
    If Not objFolder Is Nothing Then
        '// Get the path to the folder user picked. //
        strFolder = objFolder.Items.Item.Path
    Else
        '// In case user cancels folder browser     //
        MsgBox "Error picking a folder.", 0, ""
        Exit Sub
    End If
    
    '// Create various needed objects.  I happen to use late-binding.                   //
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set fsFolder = fso.GetFolder(strFolder)
    Set objol = CreateObject("Outlook.Application")
    Set objmail = objol.CreateItem(0) '(olMailItem)
    
    With objmail
        .To = "[EMAIL="Me@Wherever.com"]Me@Wherever.com[/EMAIL]"
        .Subject = "Ticket ..."
        .Body = "Here's a test"
        .NoAging = True
        
        '// Using the file system object, return/add all the Excel files in the picked  //
        '// folder.                                                                     //
        For Each fsFile In fsFolder.Files
            If fsFile.Name Like "*.xls" Then
                .Attachments.Add strFolder & "\" & fsFile.Name
            End If
        Next
        
        .Display
        
    End With
    
errhndl:
    Set objFolder = Nothing
    Set fso = Nothing
    Set fsFolder = Nothing
    Set objol = Nothing
    Set objmail = Nothing
End Sub

Hope this helps,

Mark

 

[counihan3]

Thanks I was thinking about doing that but I had no idea how thanks

 

[Kromenad]

Hi,
how do you modify the code if the path to the folder is known in advance? I need to get all the PDF files in the folder and attach it to new email.

Set objFolder = CreateObject("Shell.Application"). _
                        BrowseForFolder( _
                            0, "Select the folder that the workbooks are in.", 0, Empty)

I was trying to subtitude the CreateObject with path like "P:\SSI\", but it is not an object.

Sorry for stupid questions..

 

[kearney194]

This worked for me - I had the same issue and took out the Set objFolder and put cell value in strFolder =

Option Explicit
Sub exAddAttachments()
Dim objol As Object
Dim objmail As Object
Dim objFolder As Object
Dim strFolder As String
Dim fso As Object
Dim fsFolder As Object
Dim fsFile As Object
'---------------------------------------------------------------------------------------//
strFolder = Sheet1.Range("G20").Value

'// Create various needed objects. I happen to use late-binding. //
Set fso = CreateObject("Scripting.FileSystemObject")
Set fsFolder = fso.GetFolder(strFolder)
Set objol = CreateObject("Outlook.Application")
Set objmail = objol.CreateItem(0) '(olMailItem)

With objmail
.To = "Me@Wherever.com"
.Subject = "Ticket ..."
.Body = "Here's a test"
.NoAging = True

'// Using the file system object, return/add all the Excel files in the picked //
'// folder. //
For Each fsFile In fsFolder.Files
If fsFile.Name Like "*.pdf" Then
.Attachments.Add strFolder & "" & fsFile.Name
End If
Next

.Display

End With

errhndl:
Set objFolder = Nothing
Set fso = Nothing
Set fsFolder = Nothing
Set objol = Nothing
Set objmail = Nothing
End Sub