VBA to ZIP each files individually from the folder.

[subhas]

Hi,

I have seen queries with Zip multiple files together but want to know how to zip file separately on the same folder through VBA. This is because each file carry huge data, need to compress with zip of the same file separately. Thanks.

 

[John_w]

Try this, changing the two folder paths as required.

Public Sub Zip_Files_Individually_in_Folder()

    Dim destinationFolder As String
    Dim sourceFolder As Variant, zipFileName As Variant  'must be Variants, not Strings
    Dim WShell As Object
    Dim WShellFolderItem As Object
    
    sourceFolder = "C:\folder\path\"          'folder containing files to be zipped individually
    destinationFolder = "C:\folder\path2\"    'folder where .zip files will be created
    
    If Right(destinationFolder, 1) <> "\" Then destinationFolder = destinationFolder & "\"

    Set WShell = CreateObject("Shell.Application")
    With WShell
    
        'Loop through items in sourceFolder and zip each file separately
        
        For Each WShellFolderItem In .Namespace(sourceFolder).Items
            If WShellFolderItem.Type <> "File folder" Then
                zipFileName = destinationFolder & WShellFolderItem.Name & ".zip"
                NewZip zipFileName
                .Namespace(zipFileName).CopyHere WShellFolderItem
            End If
        Next
    
    End With

End Sub

'http://www.rondebruin.nl/win/s7/win001.htm
Private Sub NewZip(sPath)
    'Create empty Zip File
    If Len(Dir(sPath)) > 0 Then Kill sPath
    Open sPath For Output As [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=1]#1[/URL] 
    Print [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=1]#1[/URL] , Chr$(80) & Chr$(75) & Chr$(5) & Chr$(6) & String(18, 0)
    Close [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=1]#1[/URL] 
End Sub

 

[subhas]

Thanks, it misses to keep some of the excel files under zip. suppose if i have 100 files it creates zip for every file but misses to add excel data for some of the files.Pls see

 

[John_w]

I really don't understand any part of your reply. What do you mean by 'add excel data for some of the files'? The code doesn't deal with 'excel data', only files.

However, I have noticed a couple of odd things happening:

1. Sometimes the .zip files in the destination folder are not completely written until a few seconds after the macro has finished. For example, if you have MyFile.xlsx (or any extension) in the source folder, the macro creates MyFile.zip (1 KB in size) in the destination folder. You can open MyFile.zip and see that it is empty. However a few seconds later, if you reopen MyFile.zip it now contains MyFile.xlsx.

2. If you have the same file name with 2 different extensions, both files are put in the .zip file. For example, if you have Data.csv and Data.xlsx in the source folder (in that order), the macro creates Data.zip containing both files, even though the NewZip procedure explicitly deletes Data.zip if it already exists. In theory, the macro should create Data.zip containing Data.csv, then delete Data.zip, then create Data.zip containing Data.xlsx.

I think the above problems may be caused by timing issues with the Windows OS. Therefore the following revised code has an improved NewZip procedure and a short delay between the creation of each .zip file.

Option Explicit

[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If]#If[/URL]  VBA7 Then
    Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else]#Else[/URL] 
    Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End]#End[/URL]  If


Public Sub Zip_Files_Individually_in_Folder()

    Dim destinationFolder As String
    Dim sourceFolder As Variant, zipFileName As Variant  'must be Variants, not Strings
    Dim WShell As Object
    Dim WShellFolderItem As Object
    
    sourceFolder = "C:\folder\path"          'folder containing files to be zipped individually
    destinationFolder = "C:\folder\path2"    'folder where .zip files will be created
    
    If Right(destinationFolder, 1) <> "" Then destinationFolder = destinationFolder & ""

    Set WShell = CreateObject("Shell.Application")
    With WShell
    
        'Loop through items in sourceFolder and zip each file separately
        
        For Each WShellFolderItem In .Namespace(sourceFolder).Items
            If WShellFolderItem.Type <> "File folder" Then
                zipFileName = destinationFolder & WShellFolderItem.Name & ".zip"
                NewZip zipFileName
                .Namespace(zipFileName).CopyHere WShellFolderItem
                DoEvents
                Sleep 100
            End If
        Next
    
    End With

End Sub

'http://www.rondebruin.nl/win/s7/win001.htm
Private Sub NewZip(sPath)
    'Create empty Zip File
    On Error Resume Next
    While Len(Dir(sPath)) > 0 'ensure zip file is deleted
        Kill sPath
    Wend
    On Error GoTo 0
    Open sPath For Output As [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=1]#1[/URL] 
    Print [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=1]#1[/URL] , Chr$(80) & Chr$(75) & Chr$(5) & Chr$(6) & String(18, 0)
    Close [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=1]#1[/URL] 
End Sub

Note - with the above macro, if you have the same file name with two different extensions, the final .zip file contains only the second of the two files, because the .zip file containing the first of the two files was created and deleted. This feature might explain why the number of .zip files created in the destination folder is less than the number of files in the source folder.

 

[subhas]

I really appreciate your efforts to dig this further. sorry if my details were very short. The revised code works well as per my requirement.

General comment i want make it:
If i create a source & destination folder under C drive sometime it gives an error message saying "Compressed (zipped) Folders Error File not found or no read permission" This is a Microsoft issue.
If i create a source & destination folder under other drives it works well.

Thanks again for your help on this

regards,
subhas

 

[John_w]

Whilst investigating the issues with the code, I also saw that error occasionally:

Compressed (zipped) Folders Error
File not found or no read permission.
​

The error has not occurred since the changes to the code, so I would try increasing the Sleep time to increase the delay between processing files, maybe:

Sleep 200

 

[subhas]

Good suggestion, I will apply that. Thanks for your help for solving my query