Attach multiple files or entire directory to email

Question

I'm trying to send an Outlook email with multiple attachments via Excel VBA.

The code works if I specify the path to one attachment/file. I can also add multiple attachments if I know exactly what they are, but I will not. There will be different counts as well as file names.

I would love to send using a wildcard as shown in my example below but I think I'll need to use some sort of loop pointing at a directory.

I looked but I am yet to see anything that works with my situation.

Private Sub Command22_Click()
    Dim mess_body As String
    Dim appOutLook As Outlook.Application
    Dim MailOutLook As Outlook.MailItem
    Set appOutLook = CreateObject("Outlook.Application")
    Set MailOutLook = appOutLook.CreateItem(olMailItem)

    Set appOutLook = CreateObject("Outlook.Application")
    Set MailOutLook = appOutLook.CreateItem(olMailItem)
    With MailOutLook
        .BodyFormat = olFormatRichText
        .To = "[email protected]"
        .Subject = "test"
        .HTMLBody = "test"
        .Attachments.Add ("H:\test\Adj*.pdf")
        '.DeleteAfterSubmit = True
        .Send
    End With
    MsgBox "Reports have been sent", vbOKOnly
End Sub

Answer 1

Try this

Private Sub Command22_Click()
    Dim mess_body As String, StrFile As String, StrPath As String
    Dim appOutLook As Outlook.Application
    Dim MailOutLook As Outlook.MailItem
    
    Set appOutLook = CreateObject("Outlook.Application")
    Set MailOutLook = appOutLook.CreateItem(olMailItem)

    '~~> Change path here
    StrPath = "H:\test\"
    
    With MailOutLook
        .BodyFormat = olFormatRichText
        .To = "[email protected]"
        .Subject = "test"
        .HTMLBody = "test"

        '~~> *.* for all files
        StrFile = Dir(StrPath & "*.*")
        
        Do While Len(StrFile) > 0
            .Attachments.Add StrPath & StrFile
            StrFile = Dir
        Loop
        
        '.DeleteAfterSubmit = True
        .Send
    End With
    
    MsgBox "Reports have been sent", vbOKOnly
End Sub