Macro to attach Zip Files within sub-folders

[Howardc1001]

I have code to attach zip files within sub-folders with C:\Sales Reports in Microsoft outlook



The code works well and attaches some of the zip files in Outlook as the maximum limit is 20MB




I need my code amended to attach up to a max limit of 20MB and when this is reached to create a second to attach the balance of the zip files (the total off al the Zip files is less than 40MB so I only need two emails)


Your assistance in this regard is most appreciated

 Sub CreateEmail()
'---------------------------------------------------
'DECLARE AND SET VARIABLES
    Dim outApp As Object
    Dim OutMail As Object
    Dim strbody As String
    Dim Filename As String
    Set outApp = CreateObject("Outlook.Application")
    Set OutMail = outApp.CreateItem(0)
'---------------------------------------------------
'CREATE EMAIL BODY
      strbody = "Hi " & Join(Application.Transpose(Range("D1:D5").Value)) & vbNewLine & vbNewLine
            strbody = strbody & "Attached Please find latest Sales Reports" & vbNewLine & vbNewLine
            strbody = strbody & "Regards" & vbNewLine & vbNewLine
'---------------------------------------------------
'BUILD EMAIL
    On Error Resume Next
    With OutMail
           .to = Join(Application.Transpose(Range("E1:E5").Value), ";")
        .CC = ""
        .BCC = ""
        .Subject = "Sales Reports"
        .Body = strbody
        Path = "C:\Sales Reports\"
'--------------------------------------------
'GET FILENAMES
'        Filename = Dir(Path & "*.zip")
'        Do While Len(Filename) > 0
'            .Attachments.Add Filename
'            Filename = Dir
'        Loop
        
    Dim fso, oFolder, oSubfolder, oFile, col As Collection
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set col = New Collection
    col.Add fso.GetFolder(Path)

    Do While col.Count > 0
        Set oFolder = col(1)
        col.Remove 1
        For Each oSubfolder In oFolder.SubFolders
            col.Add oSubfolder
        Next oSubfolder
        For Each oFile In oFolder.Files
                       If CStr(oFile) Like "*.zip" Then
                .Attachments.Add CStr(oFile)
            End If

        Next oFile
    Loop
        .Display
    End With
'---------------------------------------------------
'CLEANUP
    On Error GoTo 0
    Set OutMail = Nothing
    Set outApp = Nothing
    Set fso = Nothing
End Sub

I have also posted on https://www.myonlinetraininghub.com/...folders#p18655

[Howardc1001]

There are 18 Zip files within the sub-folders

As an alternative to my request is to attach the first 10 files to the first email and the balance to the second email

[Howardc1001]

See solution https://www.myonlinetraininghub.com/...folders#p18718