Solved: Zipping files in a folder using VBA

[xluser2007]

Hi All,

I'm curious to know the following and is it possible (and easy) to zip all workbooks in a specified folder specified in the macro.

For example, the following code from Ozgrid, loops through all Excel files in a folder "C:\MyDocuments\TestResults" and opens them, to apply some code to them:

Sub RunCodeOnAllXLSFiles()
Dim lCount As Long
Dim wbResults As Workbook
Dim wbCodeBook As Workbook

Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False

On Error Resume Next

Set wbCodeBook = ThisWorkbook

With Application.FileSearch
.NewSearch
'Change path to suit
.LookIn = "C:\MyDocuments\TestResults"
.FileType = msoFileTypeExcelWorkbooks

If .Execute > 0 Then 'Workbooks in folder
For lCount = 1 To .FoundFiles.Count 'Loop through all.
'Open Workbook x and Set a Workbook variable to it
Set wbResults = Workbooks.Open(Filename:=.FoundFiles(lCount), UpdateLinks:=0)

'DO YOUR CODE HERE

wbResults.Close SaveChanges:=True

Next lCount
End If
End With

On Error GoTo 0
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableEvents = True
End Sub

Is there any way in the to adapt the above code to zip all the workbooks
found in the loop (instead of opening and applying a code to them), from the folder specified in the macro (e.g. "C:\MyDocuments\TestResults" in the above code)?

I've searched all around, but couldn't find anything zipping workbooks using VBA (even with Winzip).

Any help on this would be great (and I'm sure I'm not alone here) as I find I spend quite a bit of time zipping workbooks before they are sent off by email.


Thanks and regards,

[rbrhodes]

xlu,

Have a look:


http://www.rondebruin.nl/zip.htm

http://www.vb-helper.com/howto_shell_zip_and_unzip.html

etc.

I did a google...

[xluser2007]

Hi rbrhodes, thanks for your great links! Don't know how I missed them.

The code there is quite confusing for a noob like me to apply to my problem at hand.

Here is what I would like to do:

1. Basically have a workbook C:\master.xls which contains a worksheet "Folderstozip". This will control which folders and their workbooks are to be zipped.

2. In A1:A5 in "Folderstozip" I would have the relevant folders, which contain their respective workbooks to zip up.

e.g. A1 contains "C:\testmaterial"

A2 contains "D:\Files_for_emailing\Jan2008"

etc.

3. Although I'm 99% sure that they will only cotian Excel workbooks in them, I would like the macro to effectively open them up and find all the excel files and zip them up together as one.

e.g. If "D:\Files_for_emailing\Jan2008" contains test1.xls, test2.xls and test3.xls and pitchpresentation.ppt, then I would like the macro to take test1, test2 and test3 (and leave the *.ppt presentation) and zip them together as "D:\Files_for_emailing\Jan2008\spreadsheets.zip" i.e. always save all zipped spreadsheets in a folder as spreadsheets.zip in that folder.

I use Winzip (registered) so the relevant code I could find in rondebruins site was as below:

Sub Zip_Selected_Files()
Dim PathWinZip As String, FileNameZip As String, NameList As String
Dim ShellStr As String, strDate As String, sFileNameXls As String
Dim vArr As Variant, FileNameXls As Variant, iCtr As Long PathWinZip = "C:\program files\winzip\"
If Dir(PathWinZip & "winzip32.exe") = "" Then
MsgBox "Please find your copy of winzip32.exe and try again"
Exit Sub
End If FileNameXls = Application.GetOpenFilename(filefilter:="Excel Files, *.xls", _
MultiSelect:=True) If IsArray(FileNameXls) = False Then
'do nothing
Else
NameList = ""
For iCtr = LBound(FileNameXls) To UBound(FileNameXls)
NameList = NameList & " " & Chr(34) & FileNameXls(iCtr) & Chr(34) vArr = Split97(FileNameXls(iCtr), "\")
sFileNameXls = vArr(UBound(vArr))
If bIsBookOpen(sFileNameXls) Then
MsgBox "You can't zip a file that is open!" & vbLf & _
"Please close: " & FileNameXls(iCtr)
Exit Sub
End If
Next iCtr strDate = Format(Now, " dd-mm-yy h-mm-ss")
FileNameZip = "C:\MyFilesZip " & strDate & ".zip " ShellStr = PathWinZip & "Winzip32 -min -a " _
& " " & Chr(34) & FileNameZip & Chr(34) _
& " " & NameList
ShellAndWait ShellStr, vbHide MsgBox "The macro is ready"
End If
End Sub
His relevant functions are:

Declare Function OpenProcess Lib "kernel32" _
(ByVal dwDesiredAccess As Long, _
ByVal bInheritHandle As Long, _
ByVal dwProcessId As Long) As Long Declare Function GetExitCodeProcess Lib "kernel32" _
(ByVal hProcess As Long, _
lpExitCode As Long) As Long Public Const PROCESS_QUERY_INFORMATION = &H400
Public Const STILL_ACTIVE = &H103
Public Sub ShellAndWait(ByVal PathName As String, Optional WindowState)
Dim hProg As Long
Dim hProcess As Long, ExitCode As Long
'fill in the missing parameter and execute the program
If IsMissing(WindowState) Then WindowState = 1
hProg = Shell(PathName, WindowState)
'hProg is a "process ID under Win32. To get the process handle:
hProcess = OpenProcess(PROCESS_QUERY_INFORMATION, False, hProg)
Do
'populate Exitcode variable
GetExitCodeProcess hProcess, ExitCode
DoEvents
Loop While ExitCode = STILL_ACTIVE
End Sub Function bIsBookOpen(ByRef szBookName As String) As Boolean
' Rob Bovey
On Error Resume Next
bIsBookOpen = Not (Application.Workbooks(szBookName) Is Nothing)
End Function Function Split97(sStr As Variant, sdelim As String) As Variant
'Tom Ogilvy
Split97 = Evaluate("{""" & _
Application.Substitute(sStr, sdelim, """,""") & """}")
End Function

Could you please guide me to solve the problem given his code?

(For example how do I Isolate the Excel files in the specified folders, which is where I was headed with post #1).

Thanks for your help.

regards

[Dave]

Perhaps this link will be of some use. No WinZip required. Dave
http://www.vbaexpress.com/forum/showthread.php?t=17357

[xluser2007]

Hi Dave,

Sorry for my delayed reply, was night time here when you had replied.

Super post and code btw, almost does exactly what I require.

I tested it as below:

'Many thanks to Ron de Bruin for his great code
Public Function Zipp(ZipName, FileToZip)
'Zips A File
'ZipName must be FULL Path\Filename.zip - name Zip File to Create OR ADD To
'FileToZip must be Full Path\Filename.xls - Name of file you want to zip
Dim FSO As Object
Dim oApp As Object
If Dir(ZipName) = "" Then
Open ZipName For Output As #1
Print #1, Chr$(80) & Chr$(75) & Chr$(5) & Chr$(6) & String(18, 0)
Close #1
End If
Set oApp = CreateObject("Shell.Application")
oApp.Namespace(ZipName).CopyHere (FileToZip)
'Keep script waiting until Compressing is done
On Error Resume Next
Do Until oApp.Namespace(ZipName).items.Count = 1
Application.Wait (Now + TimeValue("0:00:01"))
Loop
On Error GoTo 0
On Error Resume Next
Set FSO = CreateObject("scripting.filesystemobject")
FSO.deletefolder Environ("Temp") & "\Temporary Directory*", True
Set oApp = Nothing
Set FSO = Nothing
End Function

Sub testzip()

Call Zipp("D:\Values\spreadsheet.zip", "D:\Values\B_values only.xls")

End Sub


And this worked a treat.

the only change I'd like to make is that if I could specify a folder instead of a filename, and for the code to loop through and zipp all the workbooks only in that folder as the specified ZipName. that would be awesome.

I am a bit confused as to how to "group" select all the workbooks and save as a combined zip. Any thoughts on how to achieve this?

regards.

[rbrhodes]

The comment in the code says '... file to create or ADD to.' So perhaps just create a list of files?

This will do a directory of all '*.xls' files in a folder and stores them in a Public array.



Option Explicit

Public filez

Sub GetFiles()

Dim i As Long
Dim Fname As String
Dim fPath As String

'Set dir including final "\"
fPath = "c:\testmaterial\"

'Get first file name
Fname = Dir(fPath & "*.xls")

'Put filename in array
filez = Array(Fname)

'Get remainder of files
Do Until Fname = ""

'Get next filename
Fname = Dir

'Increment array index counter
i = i + 1

'Increment array
ReDim Preserve filez(UBound(filez) + 1)

'Put filename in array
filez(i) = Fname

Loop

'Dump empty filename (last loop)
ReDim Preserve filez(UBound(filez) - 1)


'//Now call zipp for each file found

For i = LBound(filez) To UBound(filez)

Call Zipp(fPath & "spreadsheet.zip", fPath & filez(i))

Next i


End Sub




EDIT: dr replaced pseudo code

[rbrhodes]

Here is what I would like to do:

1. Basically have a workbook C:\master.xls which contains a worksheet "Folderstozip". This will control which folders and their workbooks are to be zipped.

2. In A1:A5 in "Folderstozip" I would have the relevant folders, which contain their respective workbooks to zip up.

e.g. A1 contains "C:\testmaterial"

A2 contains "D:\Files_for_emailing\Jan2008"

etc.

3. Although I'm 99% sure that they will only cotian Excel workbooks in them, I would like the macro to effectively open them up and find all the excel files and zip them up together as one.

e.g. If "D:\Files_for_emailing\Jan2008" contains test1.xls, test2.xls and test3.xls and pitchpresentation.ppt, then I would like the macro to take test1, test2 and test3 (and leave the *.ppt presentation) and zip them together as "D:\Files_for_emailing\Jan2008\spreadsheets.zip" i.e. always save all zipped spreadsheets in a folder as spreadsheets.zip in that folder.



Here's the completed package that does the above (I believe). Create a workbook with the pathnames in Col A, starting in Row 1 (you can change this in the code...). Run the sub.

NOTE: I changed one line in the Zipp function as it was entering an endless loop if the zip file already existed.








I'm still wondering where's the delete button...

[Aussiebear]

That them there "delete" button is available....... but only to a couple of people. (Sorry)

[xluser2007]

rbrhodes, you are a legend mate!

That works beautifully, very nice code indeed.

As a noob I have many queries through. Please bear with me.

1. You have the following bit of code in the main macro:
Do Until Fname = ""

'Get next filename
Fname = Dir

'Increment array index counter
i = i + 1

'Increment array
ReDim Preserve filez(UBound(filez) + 1)

'Put filename in array
filez(i) = Fname

Loop
Where is i defined previously i.e.e shouldn't i=0 just above do Until, so we set the counter initially?

2.You define the (I assume) global variable:

Public filez
Under Option explicit does this automatically make it a variant without defining it explicitly as such (I thought Option Explicit mean that you had to declare As Variant for example)?

Also (having never used arrays in VBA) can we Dimension a variable as an array, or is it always a variant in these cases?


3.In the master.xls you had posted, there is a button located in the (only) worksheet "Folderstozip". In Design mode, or by right clicking the tab and clicking "View Code", I can;t view the button to edit it or even delete. How do I access this button and how did you manage to hide it like this?

Again, thank you sincerely for your help, I'm sure many people come across the same issue everyday at work and have been helped by your Contribution :hi:.

Thanks also to Dave for pointig out his amednment to Ron de Bruins superb code :friends:.

I will keep you posted If I have any more queries.

[rbrhodes]

Hi,

You're welcome. A co-op effort for sure!

1) I Dim'd i as long so it is by default = 0. It could (and maybe should) be set to 0 by the code.

2) Option Explicit requires you to Dim all variables, however if you don't specify a type it is by default a Variant. If you dim as an array ie: Dim Arr ( ) or Dim Arr(10) or Dim Arr(10,10) etc you can specify a type as well. For instance Dim Arr(10) would give you an 11 place array for Numbers only. PS Arrays start at 0, you can use Option Base 1 to start them at 1.

The reason I used a Public variable was so that the array would stay in memory for the Function to access it. You could also avoid the Public array by passing the value to the Zipp function, much like the (zipname,filetozip) arguments...

3) The button is too simple <G>, It's not a Control from the Control Toolbox menu (which are quite complex) its from the Forms menu. Right click on it and you can Edit the text or delete it or whatever - no Design Mode required...

HTH

[xluser2007]

rbrhodes, thanks again for your help with my queries.

With regards to your respones:


1) I Dim'd i as long so it is by default = 0. It could (and maybe should) be set to 0 by the code.
Ddin't know this, but very useful.


3) The button is too simple <G>, It's not a Control from the Control Toolbox menu (which are quite complex) its from the Forms menu. Right click on it and you can Edit the text or delete it or whatever - no Design Mode required...
This is very useful, escially for creating buttons quickly and assigning test macros to them.

Again thanks for your help, I've marked the thread as Solved, but will post back with some additional queries when they come up (:)).

regards,