Excel Multiple Worksheets as Attachments

[Oprichnick]

Hello,
I have the following code that I use to send emails with specific sheets as attachments.
It works fine but I need now to send sometimes multiple attachments.

I can see that there are some topics about this, but I'm struggling to fit some answers on my code.
Is there a way to make this work as an array or something?

Sub Mail_small_Text_Outlook()




    Dim Destwb As Workbook, Sourcewb As Workbook
    Dim ws As Worksheet
    Dim OutApp As Object
    Dim OutMail As Object
    Dim FileExtStr As String, TempFilePath As String, TempFileName As String
    Dim FileFormatNum As Long
    
    On Error GoTo ErrMsg


    
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With
   
Thanks,
Oprichnick
   
   With Workbooks("DLQ.xls")
        For Each ws In .sheets

    On Error GoTo ErrMsg
                If ws.Name = "YYY" Then                Set Sourcewb = ActiveWorkbook
                'Copy the ActiveSheet to a new workbook
                Workbooks("AAA.xls").Worksheets("YYY").Copy
                Set Destwb = ActiveWorkbook
                With Destwb
                    FileExtStr = ".xls": FileFormatNum = 56
                End With
                'Save the new workbook/Mail it/Delete it
                TempFilePath = Environ$("temp") & "\"
                TempFileName = ws.Name
                Set OutApp = CreateObject("Outlook.Application")
                Set OutMail = OutApp.CreateItem(0)
                With Destwb
                    .SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
                    On Error Resume Next
                    With OutMail
                        .SentOnBehalfOfName = "blabla@domain.com"
                        .to = "person@domain.com"
                        .cc = ""
                        .bcc = ""
                        .Subject = "Reports"
                        .body = "Dear colleague," & vbNewLine & "your report" & vbNewLine & vbNewLine & "Regards," & vbNewLine & "Assistant"
                        .Attachments.Add Destwb.FullName
                        .display
                    End With
                    'Delete the file you have send
                    On Error GoTo 0
                    .Close savechanges:=False
                    Kill TempFilePath & TempFileName & FileExtStr
                End With
            End If
        Next ws
    End With
    


cleanup:
    Set OutMail = Nothing
    Set OutApp = Nothing
    With Application
        .ScreenUpdating = False
        .EnableEvents = True
    End With
    


MsgBox ("All DLQ Reports were sent to growers")


Exit Sub


ErrMsg: MsgBox ("Something went wrong" & vbNewLine & "Please try again")




End Sub

 

[Jerry Sullivan]

Hi Oprichnick,

Yes, you can modify the code to add multiple attachments. From where will the list of file names be read (will it be a hard-coded array in your macro, or will the macro be reading the file paths from a worksheet or other source)?

Does each item if this list of attachments include both the path and the full name of the files including file extensions?