Excel VBA Send Files to Zip Drive

Zipping up Excel files on the fly can be a most useful activity especially if working with outlook.  You may wish to generate a set of files with Excel VBA then zip those files and send them on to a list of people for review or as part of a monthly reporting procedure.  I have seen plenty of these type of procedures.  The most famous of which is on Ron De Bruin’s site.

Ron De Bruin Zipping

The idea behind the concept is to have a file path with files inside it.  The zip procedure runs and sends all of the files to a compressed zip file and saves the file in a designated folder.

The source is the location of the files and the Destination is where you want the Zip file saved to.  Note to the wize – these can not be the same folder.

This is my attempt at the same procedure.  Using my knowledge of VBA I think I can simplify the procedure quite a bit.

Option Explicit

Sub CreateZip()
Dim FileNameZip
Dim FolderName
Dim strDate As String
Dim oApp As Object

FolderName = [C10] ‘Files to ZIP
strDate = Format(Now, ” dd-mmm-yy h-mm-ss”)
FileNameZip = [C11] & “MyFilesZip ” & strDate & “.zip”

NewZip (FileNameZip) ‘New Zip File
Set oApp = CreateObject(“Shell.Application”)
oApp.Namespace(FileNameZip).CopyHere oApp.Namespace(FolderName).items ‘Copy

On Error Resume Next ‘Pause till Compress is done
Do Until oApp.Namespace(FileNameZip).items.Count = oApp.Namespace(FolderName).items.Count
Application.Wait (Now + TimeValue(“0:00:01”))
Loop
On Error GoTo 0
End Sub

 

‘Second procedure – this ia required.
Sub NewZip(sPath)
Open sPath For Output As #1
Print #1, Chr$(80) & Chr$(75) & Chr$(5) & Chr$(6) & String(18, 0)
Close #1
End Sub

The following Excel file runs the zip procedure.  The VBA runs very smoothly and very quickly.  I was quite pleased with the final outcome.

ExcelZip.xls