Macro to attach all zip files

Topic

New Reply

It would be appreciated if someone can assist me in witing code to attach all zip files in a folder C:downloads as well as the sub-folders in this folder

I will save the code in a template

Reply | Quote

Replies

Howard,

Here is sample code to create an email and attach all the zip files in a folder. Replace the blue lines with values that pertain to your situation.

HTH,
Maud

Code:

Sub CreateEmail()
[COLOR=”#008000″]’—————————————————
‘DECLARE AND SET VARIABLES[/COLOR]
    Dim outApp As Object
    Dim OutMail As Object
    Dim strbody As String
    Dim Filename As String, strbody As String
    Set outApp = CreateObject(“Outlook.Application”)
    Set OutMail = outApp.CreateItem(0)
[COLOR=”#008000″]’—————————————————
‘CREATE EMAIL BODY[/COLOR]
    strbody = “[COLOR=”#0000FF”]EMAIL BODY GOES HERE[/COLOR]”
[COLOR=”#008000″]’—————————————————
‘BUILD EMAIL[/COLOR]
    On Error Resume Next
    With OutMail
        .To = “[COLOR=”#0000FF”]JohnDoe@gmail.com[/COLOR]”
        .CC = “”
        .BCC = “”
        .Subject = “[COLOR=”#0000FF”]SUBJECT GOES HERE[/COLOR]”
        .Body = strbody
        Path = “[COLOR=”#0000FF”]C:UsersMaudibeDesktop[/COLOR]”
[COLOR=”#008000″]’——————————————–
‘GET FILENAMES[/COLOR]
        Filename = Dir(Path & “*.zip”)
        Do While Len(Filename) > 0
            .Attachments.Add Filename
            Filename = Dir
        Loop
        .Display
    End With
[COLOR=”#008000″]’—————————————————
‘CLEANUP[/COLOR]
    On Error GoTo 0
    Set OutMail = Nothing
    Set outApp = Nothing
End Sub

Reply | Quote

Hi Maud

I certainly forgot about this post. Thanks very much for providing me with the code. Must this be set up in an Outlook Template or can I set this up rather in Excel ?

Where there is a PM, I am receiving these via email, but not replies to other posts. How do I set this up so I receive emails where someone has replied to one of my posts?

Reply | Quote

Hi Maud

I have tested your code. I have a few zip files in a directory called C:pull as well several zip files in the subdirectory of C:pull for e,g. C:pullBR1TB C:PullBr7TB etc

Outlook is activated but no zip files are being attached

I have attached my template. Please test & advise

Reply | Quote

Howard,

ooops…You will need to add .Display as the next line after .Body = strbody

Reply | Quote

Howard,

Try changing the path from Path = “C:pull” to Path = “C:pull”

Maud

Reply | Quote

Hi Maud

I had tried changing the path from Path = “C:pull” to Path = “C:pull” when I was testing the macro, but still no files were being attached

See sample of zip file in C:pull directory. Not sure why this is not being attached

It would be appreciated if you could test and advise

Reply | Quote

Howard,

I think you zipped and uploaded to wrong file.

I have tested the code and it attaches the zipped files flawlessly. Make sure you have the correct path and it ends with a “”. Also make sure you have zipped files in the directory with the extension .zip
Maud

41368-Howard

Reply | Quote

Hi Maud

I think that although my file is zipped and has a ,zip extension , it looks like it was created in notepad

This may be the reason, it may not be attaching

See screen print attached of what the zip file looks like

I only have an evaluation copy of winzip

Do you have any idea how I can resolve this?

It would be appreciated if you can please shed some light on this

Reply | Quote

Howard,

It should not matter on the format. As long as the extension is .zip (all small), it should attach it. I am suspecting that the file is actually named Book6.zip.txt and not a zipped file at all.

HTH,
Maud

Exactly what is the file Book6.xlsx in the uploaded zipped file of post #6 supposed to be?

Reply | Quote

Hi Maud

Thanks for your input

Book6.xlsx was nothing more that some sample data. I am not using this for anything. I just wanted to zip the file and attach using your code

I will install a full version of WinZip & Re-test

Reply | Quote

Might want to take a look at 7-Zip. Fully function free version

Reply | Quote

Hi Maud

I have amended the code from

Code:

 .Attachments.Add Filename 

to

Code:

 .Attachments.Add Path & Filename 

The .zip files in folder “C:pull now attach in Outlook.

However the .zip files in the sub-directory of C:pull for eg C:pullBR1TB C:pullCPETB etc are not attaching

It would be appreciated if you would kindly amend the code to attach the .zip files in the sub-folders as well

Reply | Quote

Hi Maud

You recently helped me to email zip files. It would be appreciated if you would kindly amend the code to exclude zip files containing “backup” in the name of the zip file

Code:

 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 Management Account" & 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 = "Accounts"
        .Body = strbody
        Path = "C:test1l"
'--------------------------------------------
'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 

Reply | Quote

Howard,

It should not matter on the format. As long as the extension is .zip (all small), it should attach it. I am suspecting that the file is actually named Book6.zip.txt and not a zipped file at all.

I think Maudibe is correct as the icon pictured with the file book6.zip shows it as a text file.

Reply | Quote

Howard,

You have modified my code with a fair amount of complexity. You have proved yourself worthy to solve this. Look into something like:

=instr(1,filename,”backup”,1)>0

as a test to see if the filename contains the word “backup”

HTH,
Maud

Reply | Quote

Hi Maud

You provided me with code to attach zip files in a folder. Is it possible to attach 10 files per email as the file size is too large as some companies limit the total file size to 10gb. If so kindly amend the code so that the first 10 zip files are attach to email 1 , the second 10 to email 2 etc until all the zip files have been attached

It would be appreciated if you would kindly assist

Code:

 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 Management Account" & 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 = "Management Accounts"
        .Body = strbody
        Path = "C:pull"
'--------------------------------------------
'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 InStr(1, oFile, "Backup", 1) > 0 Then
        
        Else

                       If CStr(oFile) Like "*.zip" Then
                .Attachments.Add CStr(oFile)
            End If
               End If
        Next oFile
    Loop
        .Display
    End With
'---------------------------------------------------
'CLEANUP
    On Error GoTo 0
    Set OutMail = Nothing
    Set outApp = Nothing
    Set fso = Nothing
End Sub 

Reply | Quote

Hi Maud

Thanks for the positive feedback and for your input

I have modified the code to

Code:

 If InStr(1, oFile, "Backup", 1) > 0 Then
        
        Else

                       If CStr(oFile) Like "*.zip" Then
                .Attachments.Add CStr(oFile)
            End If 

Reply | Quote