vbaexcel

Attach Multiple files via VBA


Can someone please help me edit below script to add multiple files listed on 3rd column (Column C) of the spreadsheet?

My current macro looks for one file at a time and sends out individual emails. I need it to look for multiple files name (in listed folder path) listed in column C (3rd Column) and it does this until it reaches the empty cell.

My current scrip is below where you will see it looks for one file at a time.

Sub AttachandSendEmail()
Dim obMail As Outlook.MailItem
Dim irow As Integer
Dim dpath As String
Dim pfile As String

'file path
dpath = "C:\Users\filelocation"

'looping through all the files and sending an mail

irow = 1

Do While Cells(irow, 3) <> Empty


'pikcing up file name from column C
 pfile = Dir(dpath & "\*" & Cells(irow, 3) & "*")


'checking for file exist in a folder and if its a pdf file

If pfile <> "" And Right(pfile, 3) = "pdf" Then

    Set obMail = Outlook.CreateItem(olMailItem)

    With obMail
        .To = "email@comapny.com"
        .Subject = "O/S Blanace"
        .BodyFormat = olFormatPlain
        .Body = "Please see attached files"
        .Attachments.Add (dpath & "\" & pfile)
        .Send
    End With

End If

'go to next file listed on the C column
 irow = irow + 1

Loop


End Sub

Solution

  • Try this, it sends one message with all files attached.

    Set obMail = Outlook.CreateItem(olMailItem)
    With obMail
        .To = "email@comapny.com"
        .Subject = "O/S Blanace"
        .BodyFormat = olFormatPlain
        .Body = "Please see attached files"
    
        Do While Cells(irow, 3) <> Empty
            'pikcing up file name from column C
            pfile = Dir(dpath & "\*" & Cells(irow, 3) & "*")
            'checking for file exist in a folder and if its a pdf file
    
            If pfile <> "" And Right(pfile, 3) = "pdf" Then
                .Attachments.Add (dpath & "\" & pfile)
            End If
    
            'go to next file listed on the C column
            irow = irow + 1
        Loop
    
        .Send
    End With