Recently, I have been working on a project which requires the zipping and unzipping files and folders. Zip files are now a common method of compressing files and folders for sharing. As software becomes more complex, file sizes increase, however there is often a limit to the file size an e-mail provider will allow. For example, Google currently allows a maximum file size of 25MB to be sent. Putting all the attachments into a single zip file can help get around this issue, as the files are compressed to be smaller.
The code snippets below are based on a section from Excel 2016 Power Programming with VBA by Michael Alexander/Dick Kusleika and from Ron de Bruin’s site.
Whilst working with Zip files, I wanted to make a reusable procedure which I could call when ever required. The code below was created for that purpose. These code snippets do not create, delete or check for the existence of the files or folders which it uses. Check out the following code snippets to cover these areas:
UPDATE : As discussed in the comments section below. Do not declare a String variable to hold the file paths, this will not work with the Shell.Application. Declare a Variant variable to hold the file paths, this will ensure the code runs smoothly.
This procedure has only a few steps:
Sub CreateZipFile(folderToZipPath As Variant, zippedFileFullName As Variant) Dim ShellApp As Object 'Create an empty zip file Open zippedFileFullName For Output As #1 Print #1, Chr$(80) & Chr$(75) & Chr$(5) & Chr$(6) & String(18, 0) Close #1 'Copy the files & folders into the zip file Set ShellApp = CreateObject("Shell.Application") ShellApp.Namespace(zippedFileFullName).CopyHere ShellApp.Namespace(folderToZipPath).items 'Zipping the files may take a while, create loop to pause the macro until zipping has finished. On Error Resume Next Do Until ShellApp.Namespace(zippedFileFullName).items.Count = ShellApp.Namespace(folderToZipPath).items.Count Application.Wait (Now + TimeValue("0:00:01")) On Error GoTo 0 End Sub
To call the procedure above the following code can be used within another procedure. Change the paths to be the folder you wish to zip and the name you want the zip folder to be called.
Call CreateZipFile("C:\Users\marks\Documents\ZipThisFolder\", "C:\Users\marks\Documents\NameOFZip.zip")
This procedure will overwrite any zip folder with the same name.
Unzipping is a much easier process and only requires the files to be copied from the zip file into the folder.
Sub UnzipAFile(zippedFileFullName As Variant, unzipToPath As Variant) Dim ShellApp As Object 'Copy the files & folders from the zip into a folder Set ShellApp = CreateObject("Shell.Application") ShellApp.Namespace(unzipToPath).CopyHere ShellApp.Namespace(zippedFileFullName).items End Sub
To call the procedure above the following code can be used within another procedure. Change the paths to be the name of the zip file you wish to unzip and the folder you wish to put the unzipped files into.
Call UnzipAFile("C:\Users\marks\Documents\ZipHere.zip", "C:\Users\marks\Documents\UnzipHereFolder\")
It is rarely explained how this code creates a zip file. Let me show you.
Create an empty zip file just using windows. Right-click in a folder and select New-> Compressed (zipped) folder.
Now open that file in Notepad. The section of code (highlighted in blue) informs windows this file is a zip file. The file is empty, so there is no code from other files in there.
The code below is the line which inserts that same character string at the start of the file. As a result, Windows believes this is a zip folder.
Print #1, Chr$(80) & Chr$(75) & Chr$(5) & Chr$(6) & String(18, 0)
Even if we’ve created a zip file, we still need to get the files into it. The native VBA code is not able to copy to/from a zip file, so the code uses the Shell.Application to copy the files. Using the Shell.Application is similar to using the Windows environment, which is able to copy and paste files into a zip folder.
It is these two things together which really drive the functionality of this code.
Hi Yasser,
Possible causes for the ’91’ error could be:
(1) The file name and file path to the zip file is not correct
(2) The file path to the unzip location folder is not correct
(3) The word ‘Set’ is missing from the start of the following line of code:
Set ShellApp = CreateObject(“Shell.Application”)
I should also say that whilst the code snippets above will create the Zip file, all the folder paths must already exist.
There are other snippets in the code library to create, delete and check for existence of folder and files.
Reply
Hi guys,
I am trying so hard to make my code below running and I can’t figure out why I am getting Run-time error 91!
My variables are declared as variants (as they should be), the paths are correct and folders are created.
The purpose of this code is to ask for folder with zipped files and then extract all ZIP files into the existing path e.g. “c:\test\NEW_PROJECT\”
[CODE]
Sub create_new_project()
Dim oApp As Object
Dim FolderWithZipFiles As Variant
Dim UnzipedDirPath As Variant
Dim ProjectPath As Variant
Dim ZipName As Variant
Dim ZipPath As Variant
ProjectPath = “c:\test\”
UnzipedDirPath = ProjectPath & “NEW_PROJECT\”
FolderWithZipFiles = GetFolder
ZipName = Dir(FolderWithZipFiles & “\*.zip”)
Do While ZipName “”
ZipPath = FolderWithZipFiles & “\” & ZipName
Set oApp = CreateObject(“Shell.Application”)
oApp.Namespace(UnzipedDirPath).CopyHere oApp.Namespace(ZipPath).Items
End Sub
Function GetFolder(Optional strPath As String) As Variant
Dim fldr As FileDialog
Dim sItem As String
Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
With fldr
.Title = “Choose a folder with ZIPed analyzes”
.AllowMultiSelect = False
.InitialFileName = strPath
If .Show -1 Then GoTo NextCode
sItem = .SelectedItems(1)
End With
NextCode:
GetFolder = sItem
Set fldr = Nothing
End Function
[/CODE]
Can anyone help me please? I spent few hours solving why the hell I get the Run-time 91 error. Thanks a lot!
Reply Needs to become
(3) Add the following line just above the Loop command:
ZipName = Dir
Then it should work.
Reply
Hi Excel Off The Grid,
points 1 and 2 are actually the way you proposed in my code. It has just been copied here in some strange way. I certainly have marks in the correct place as you proposed. The last point makes sence and I added it to my code but it still didn’t solve my issue with run-time error 91.
I also tried to convert the type of variables by CVar() like this:
oApp.Namespace(CVar(UnzipedDirPath)).CopyHere oApp.Namespace(CVar(ZipPath)).Items
Still getting the error 91 and dunno why 🙁
ReplyAfter making the changes I noted above I was able to get files to unzip – I will send you the exact code.
This makes me think it is not an issue with the VBA code, but an alternative issue.
Thank you very much for your reply
I have my files on desktop >> the compressed file is “TestFolderZipped” and there is a folder named “TestFolder” on the desktop too
And the excel file on the desktop too
And I used this code
Sub Test_UnZipFile()
Dim strPath As String
strPath = ThisWorkbook.Path & “\TestFolder\”
If Len(Dir(strPath, vbDirectory)) = 0 Then MkDir strPath
Call UnZipFile(ThisWorkbook.Path & “\TestFolderZipped.zip”, strPath)
MsgBox “Done…”, 64
End Sub
Sub UnZipFile(zippedFileFullName As Variant, unzipToPath As Variant)
Dim shellApp As Object
Set shellApp = CreateObject(“Shell.Application”)
shellApp.Namespace(unzipToPath).CopyHere shellApp.Namespace(zippedFileFullName).items
End Sub
If you define the strPath as a Variant rather than a String, it should work.
Replace this:
Dim strPath As String
With this:
Dim strPath As Variant
Let me know if that solves it.
Reply
Thanks a lot .. That worked fine and great
But why Variant
Is this line : ThisWorkbook.Path & “\TestFolder\” is considered String?
Somebody may correct me on this, but I believe it’s because the Shell.Application views it as a folder object rather than a String, which is why it needs to be a Variant. By passing a String between the procedures it remains as a String, therefore it is necessary to create it as a Variant initially.
ReplyWant small help from vba experts, have data with multiple clients mapped to employee in Excel which later I am saving in . PDF file format of every client mapped on the basis of employee for I. G.
Client1_emp1
Client2_emp1
Client3_emp2
Client4_emp2
Now want to zip on the basis of emp and send email to emp
Kindly suggest
ReplyHi Ashwin,
Thanks for the question. I will send you an e-mail. Hopefully I can get a few more details and help you out.
ReplyHi Ashwin – as this is not a support forum, I can only help readers with specific problems if and when I have time.
I have received your file, but not had chance to look at it yet. I hope to look at it later today.
As it appears you want a faster resolution than I can provide, I suggest you try the Mr Excel forum. Alternatively Ron de Bruin’s site provides code you could adapt.
ReplyDear All
Hope you are fiine.
I have an issue with my vba code. Would it be possible to help.
Indeed, when I run the macro I have this issue: Argument not optional
Many thanks for your support
Sub Unzip()
‘Dim fpath1 As String
Dim fpath, fpath2 As String
Dim fname00, fname01 As Range
Set fname00 = Range(“E1”)
Set fname01 = Range(“E2”)
‘fpath1 = Worksheets(“DB”).Range(“E6”).Value
fpath2 = Worksheets(“DB”).Range(“E10”).Value
For i = 1 To 3
fpath = “G:\DGI\Commun\Risk Management\04. Gestion des risques\16.Compliance Reports Zest\” & fname00 & “\” & fname01 & “\” & “Reports” & (i) & “.zip”
Call UnzipAFile(fpath, fpath2)
Next i
End Sub
Sub UnzipAFile(zippedFileFullName As Variant, unzipToPath As Variant)
Dim ShellApp As Object
ShellApp = CreateObject(“Shell.Application”)
Shell.Namespace(unzipToPath).copyhere Shell.Namespace(zippedFileFullName).items
End Sub
ReplyHi Abou,
From looking at your code there appear to be a few of issues:
1) fpath and fpath2 need to be created a Variant variables, rather than String variables. (See Yasser’s question above).
2) ShellApp = CreateObject(“Shell.Application”) needs have Set at the start because it is an object. It becomes:
Set ShellApp = Create….etc.
3) Both instances of Shell.Namespace in the last line of code should be changed to ShellApp.Namespace
Then I think it should work.
Reply
hi all,
apologies for my ignorance but I just cant get this to work. I have a folder named “New Folder (2)” this folder contains 20 pdf documents.
I have coding that will count the files in the folder. I then want it to, if the file count is over 10, create a zip folder, add all the files to it, save the zip folder in the current location and delete all the original pdf’s. (leaving only the zip folder in New Folder (2))
I have trawled the internet and have several problems with any and all codes that I have found.
using this code (which ive copied and pasted) lets start with my first error
I press F8 to step into the code and it just beeps at me, nothing happens.
forgive my complete stupidity but help!
Reply
Managed to get this to work. was indeed my stupidity haha
thanks for this code it works a treat
Hi Rick,
Thanks for the question. It’s great news that you managed to get it working.
Reply
Thanks Mark. I used the above code for create zip file (ill be honest I didn’t understand the on error bit so I left it out). still works so im happy.
thanks for this great info. next step-delete the files once i’ve zipped. time for a search!
thanks again
Sub Zip_All_Files_in_Folde(s As String)
Dim DefPath As String
Dim strDate As String
Sheet4.Select
DefPath = “D:\subi\”
For i = 100 to 103
Dim oApp As Object
Dim FileNameZip, FolderName
FolderName = DefPath & i ‘ “d:\kyc\100” ‘ the zipping folder name ‘<< Change
strDate = Format(Now, " dd-mmm-yy h-mm-ss")
FileNameZip = DefPath & "subi.zip" ' to be the zipped folder
'Create empty Zip File
NewZip (FileNameZip)
Set oApp = CreateObject("Shell.Application")
'Copy the files to the compressed folder
oApp.Namespace(FileNameZip).CopyHere oApp.Namespace(FolderName)
Set oApp = Nothing
Set FileNameZip = Nothing
Set FolderName = Nothing
End Sub
My issue is while zipping the 102 folder zipping with out any contants.
If I tried
oApp.Namespace(FileNameZip).CopyHere oApp.Namespace(FolderName).items
instead of
'oApp.Namespace(FileNameZip).CopyHere oApp.Namespace(FolderName)
all the files will be zipped . But my requirement is if i unzipped the 101 folder with the option extract here, 101 folder should be extracted with its contents in it.
Thanks
I also had the Error 91.
My zippedFilePath was being imported from a global variable set prior: “Public ZipFilePath as String”, which was set to “C:\MyZippedFiles\”.
Once it reset is as “Public ZipFilePath as Variant”, it worked fine.
ReplyHi All,
The unzipping code is working fine for me. But i have another issue that after unzipping i am moving the file to a certain folder. I am using the below syntax for this unzipping and file moving
ShellApp.Namespace(unzipToPath).CopyHere ShellApp.Namespace(zippedFileFullName).items
Before unzipping i don t know the file name so unable to check that file already exists or not in the target folder. so after executing this line some times file replace windows is coming , so manually i have to click the replace file option. I have used Application.DisplayAlerts = False, still getting the replace file window. Please help me here.
Thanks in advance.
Srimanta
Hi Srimantra – why aren’t you using standard VBA to move the files? Check out this post for some possible examples:
https://exceloffthegrid.com/vba-code-to-copy-move-delete-and-manage-files/
Thanks for this code.
I tried running it in Word 2007, on a Win10 machine and when the code gets to the copyhere statement I get a ‘message :-
‘Please insert the last disk of the multi-volume set and press OK to continue’ so I’m guessing there’s something about the file header it doesn’t like, but what?
My advice would be to upgrade to a 365 subscription, and make use of all the new features 🙂
Word 2007 is a very old version, which I don’t have. Without recreating the issue, I’m not sure I can help much further.
ReplyHi All,
I’m trying to save an zip attachment containing excel file received over email. Although I’m able to automate the file to save in folder but not able to unzip the file to get the excel file it contains. I get an error under:
Set ShellApp = CreateObject(“Shell.Application”)
ShellApp.NameSpace(zippedFileFullName).CopyHere ShellApp.NameSpace(unzipToPath).Items
Can someone please help?
Below is the code:
Public Sub Unzip22(itm As Outlook.MailItem)
On Error Resume Next
Dim objAtt As Outlook.Attachment
Dim saveFolder As String
Dim Fname As Variant
Dim ShellApp As Object
Dim fpath1 As Variant
Dim fpath2 As Variant
saveFolder = “C:\Unzip\”
fpath1 = “C:\Unzip\OPEN ITEMS SIMPLE UASCC INCL LINES.xlsx.zip”
fpath2 = “C:\Users\manish.shetty\Desktop\unZipFolder\”
For Each objAtt In itm.Attachments
posr = InStrRev(objAtt.fileName, “.zip”)
ext = Right(objAtt.fileName, Len(objAtt.fileName) – posr)
posl = InStr(objAtt.fileName, “.”)
Fname = Left(objAtt.fileName, posl – 1)
objAtt.SaveAsFile saveFolder & “\” & Fname
Set objAtt = Nothing
‘Delete all other files in the folder
On Error Resume Next
Kill saveFolder & “\*.jpg*”
On Error GoTo 0
On Error Resume Next
Kill saveFolder & “\*.jpeg*”
On Error GoTo 0
On Error Resume Next
Kill saveFolder & “\*.gif*”
On Error GoTo 0
On Error Resume Next
Kill saveFolder & “\*.txt*”
On Error GoTo 0
On Error Resume Next
Kill saveFolder & “\*.doc*”
On Error GoTo 0
On Error Resume Next
Kill saveFolder & “\*.ppt*”
On Error GoTo 0
On Error Resume Next
Kill saveFolder & “\*.xml*”
On Error GoTo 0
On Error Resume Next
Kill saveFolder & “\*.png*”
On Error GoTo 0
Call UnzipAFile(fpath1, fpath2)
End Sub
Sub UnzipAFile(zippedFileFullName As Variant, unzipToPath As Variant)
Dim ShellApp As Object
Dim fpath1 As Variant
Dim fpath2 As Variant
‘Copy the files & folders from the zip into a folder
Set ShellApp = CreateObject(“Shell.Application”)
ShellApp.NameSpace(zippedFileFullName).CopyHere ShellApp.NameSpace(unzipToPath).Items
End Sub
ReplySorry, but no it’s not possible. The VBA code calls the standard Windows zip and unzip procedure.
Reply
Hello!
I would really appreciate if you could help me to debug it. I am getting run-time error 91 on the row “ShellApp.Namespace(zippedFileFullName).CopyHere ShellApp.Namespace(folderToZipPath).items”
The folder is created. It contains one excel file to be zipped. My code is almost as in the article above, I just specified the path and the file name:
Sub CreateZipFile()
Dim folderToZipPath As Variant
Dim zippedFileFullName As Variant
Dim ShellApp As Object
folderToZipPath = “C:\Users\XXX\Desktop\ZIPtest\”
zippedFileFullName = “TestZIP”
‘Create an empty zip file
Open zippedFileFullName For Output As #1
Print #1, Chr$(80) & Chr$(75) & Chr$(5) & Chr$(6) & String(18, 0)
Close #1
‘Copy the files & folders into the zip file
Set ShellApp = CreateObject(“Shell.Application”)
ShellApp.Namespace(zippedFileFullName).CopyHere ShellApp.Namespace(folderToZipPath).items
‘Zipping the files may take a while, create loop to pause the macro until zipping has finished.
On Error Resume Next
Do Until ShellApp.Namespace(zippedFileFullName).items.Count = ShellApp.Namespace(folderToZipPath).items.Count
Application.Wait (Now + TimeValue(“0:00:01”))
On Error GoTo 0
End Sub
The issue is because the zippedFileFullName needs to refer to a valid file path, then the file name.
Example:
zippedFileFullName = "C:\Users\XXX\Desktop\TestZIP.zip" ReplyHi is there a way of doing a loop to unzip all the files in a folder and move them to another folder using excel vba. I was looking to do this using a batch file but could not see anything for windows
ReplyThe code to loop through all the files in a folder is here: https://exceloffthegrid.com/vba-code-loop-files-folder-sub-folders/
The code to copy a file is here: https://exceloffthegrid.com/vba-code-create-delete-manage-folders/
I would recommend looping through the files in the folder first, creating an array of the zip files. Then looping through the array of zip files to carry out the actions on each zip.
The code for dealing with VBA arrays is here: https://exceloffthegrid.com/vba-arrays/
Hope this helps 🙂
ReplyHello, Thanks for the ideas on better use of VBA. These hints are greatly appreciated. I think the unzipping method will be a big productivity enhancement for data retrieval from zip archive and parsing. I worked through the bugs and have a working prototype for use tomorrow. I will migrate this capability as I go forward.
ReplyNote that this method of zipping folders has the inherent limitations of that operation, including not being compatible with any files or folder names containing non-ASCII characters, such as the en dash. ALL Files or folders using these characters will have to be renamed first, to get this to work.
ReplyIs there a way for when you call the procedure you can have the folder and the Zip File name be referenced by cells on the excel sheet?
Call CreateZipFile(“C:\Users\marks\Documents\ZipThisFolder\”, “C:\Users\marks\Documents\NameOFZip.zip”)
and then loop it through a list in excel as well?
ReplyYes, there is a way. Just change the text strings for cell references. Eg.
Sheets("Sheet1").Range("A1").Value Reply
Thanks for that great example, however I get the following error message
‘Object variable or With bloc variable undefined’
(translated from French, original message is ‘Variable objet ou variable de bloc With non définie’)
It happens when executing the line
ShellApp.Namespace(zippedFileFullName).CopyHere ShellApp.Namespace(folderToZipPath).Items
I guess it’s because I’m trying to zip a folder that contains files AND subfolders containing other files, but I’m not sure. Do you have any clue to solve this, please ?
Reply
Hi friend, how can I unzip with a password file using this method? Where would I put the parameter?
Reply
Hi ExcelOffTheGrid
I’ve read the comments above. Hoping you can Help PLEASE. I tried to solve this myself but also get a 91 error. Your guidance will be much appreciated.
Sub openReadFil()
Dim unzipToPath As String, zippedFileFullName As String
linkDocmnt ‘allows to select the zip folder with file picker
FolderCreate sSys.Range(“B13”).Value ‘creates a folder where zip files will be posted
zippedFileFullName = sSys.Range(“B12”).Value ‘F:\Dropbox\DataUpdate\AppDataUpdate.zip
unzipToPath = sSys.Range(“B13”).Value & “\” ‘F:\Dropbox\DataUpdate\AppDataUpdate\
UnzipAFile zippedFileFullName, unzipToPath
ImportTextFileToExcel
removeBrackets sGuidValues
End Sub
Sub UnzipAFile(zippedFileFullName As Variant, unzipToPath As Variant)
Dim ShellApp As Object
‘Copy the files & folders from the zip into a folder
Set ShellApp = CreateObject(“Shell.Application”)
ShellApp.Namespace(unzipToPath).CopyHere ShellApp.Namespace(zippedFileFullName).items
End Sub
ReplyI found a solution to error 91. I hope it helps some readers here. The person used the CStr command to solve this.
Sub UnzipAFile(zippedFileFullName As Variant, unzipToPath As Variant)
Dim ShellApp As Object
‘Copy the files & folders from the zip into a folder
Set ShellApp = CreateObject(“Shell.Application”)
ShellApp.Namespace(unzipToPath).CopyHere ShellApp.Namespace(CStr(zippedFileFullName)).items
End Sub
ReplySo the zippedFileFullName must be something that is not recognized as text. So CStr converts it to a string. Thanks for the addition.
Reply30 Most Useful Excel VBA Macros
Automate Excel, save time, stop doing the jobs a trained monkey could do.