Home » excel » Sending multiple attachments from excel sheet with VBA

Sending multiple attachments from excel sheet with VBA

Posted by: admin April 23, 2020 Leave a comment

Questions:

I have the existing code to send a mail from a Sheet in my Excel file –

Sub CreateMail()

    Dim objOutlook As Object
    Dim objMail As Object
    Dim rngTo As Range
    Dim rngSubject As Range
    Dim rngBody As Range
    Dim rngAttach As Range

    Set objOutlook = CreateObject("Outlook.Application")
    Set objMail = objOutlook.CreateItem(0)

    Application.ScreenUpdating = False
    Worksheets("Mail List").Activate

    With ActiveSheet
        Set rngTo = .Range("B1")
        Set rngSubject = .Range("B2")
        Set rngBody = .Range("B3")
        Set rngAttach = .Range("B4")

    End With

    With objMail
        .To = rngTo.Value
        .Subject = rngSubject.Value
        .body = rngBody.Value
        .Attachments.Add rngAttach.Value
        .display 'Instead of .Display, you can use .Send to send the email _
                    or .Save to save a copy in the drafts folder
    End With

    Set objOutlook = Nothing
    Set objMail = Nothing
    Set rngTo = Nothing
    Set rngSubject = Nothing
    Set rngBody = Nothing
    Set rngAttach = Nothing

End Sub

However, I want to include a number of attachments, and hence the
Set rngAttach = .Range("B4") does not help to do this.

Any help on this?
Thanks in advance!

How to&Answers:

Enclose your .Attachments.Add statement in loop. Something like below might work

    For i = 4 To 6
      .Attachments.Add Range("B" & i).Value
    Next i 

Answer:

To make it Dynamic you can set the upper limit of i to the last row in Column B

For i = 4 To Range("B" & rows.count).end(xlUp).row
  .Attachments.Add Range("B" & i).Value
Next i 

Answer:

This updated code:

  1. Looks for file names from B4
  2. Uses Dir to ensure the attached files actually exist at the specified path
  3. Tidies up the worksheet code (Activate is unnecessary)

    Sub CreateMail()
    
    Dim objOutlook As Object
    Dim objMail As Object
    Dim rngTo As Range
    Dim rngSubject As Range
    Dim rngBody As Range
    Dim rngAttach As Range
    Dim rng2 As Range
    Dim ws As Worksheet
    
    
    Set objOutlook = CreateObject("Outlook.Application")
    Set objMail = objOutlook.CreateItem(0)
    
    Application.ScreenUpdating = False
    Set ws = Worksheets("Mail List")
    
    With ws
        Set rngTo = .Range("B1")
        Set rngSubject = .Range("B2")
        Set rngBody = .Range("B3")
        Set rngAttach = ws.Range(ws.[b4], ws.Cells(Rows.Count, "B").End(xlUp))
    End With
    
    With objMail
        .To = rngTo.Value
        .Subject = rngSubject.Value
        .body = rngBody.Value
        For Each rng1 In rngAttach.Cells
            If Len(Dir(rng1)) > 0 Then .Attachments.Add rng1.Value
        Next
    
        .display 'Instead of .Display, you can use .Send to send the email _
                    or .Save to save a copy in the drafts folder
    End With
    
    Set objOutlook = Nothing
    Set objMail = Nothing
    Set rngTo = Nothing
    Set rngSubject = Nothing
    Set rngBody = Nothing
    Set rngAttach = Nothing
    
    End Sub