A couple of years ago I was involved in the implementation of a software system that required data files transferred to the hosted system via FTP. Each set of data required four different files to be bundled together in a compressed format. Most of the time, the data we needed could be pulled right out of mainframe systems. But there was one exception. One particular data element had to come from Excel files we were using at the time. There was no getting around it.
I started doing some research on Winzip and how to control it using VBA. Turns out it was both simple and not so simple. The simple stuff was that Winzip has some command line options that are, apparently, undocumented. If you want a great, concise explanation of these, check out this page. Using the Shell command in VBA, I could easily control Winzip in the way I needed. The not so simple stuff was controlling which of the parameters I would send to the command line, which depended entirely on the state of the Excel file. And I needed to be able to do that dynamically.
What I ended up doing was wrapping the various bits and pieces of Winzip and its parameters in a class module. That way, as the code finished compiling the data into the requisite .TXT file, I could then call the Winzip class module and bundle it along with the other files together and fire them off to a shared network location for processing.
Below is the code. If you want to use it, just copy it all and place it into a class module called CWinzip (or whatever you want to call it). The usually rules apply, use at your own risk, I assume no responsibility, etc. Also, if you have any suggestion as to how to improve this code, I’m always open to hearing ideas.
'---------------------------------------------------------------------------------------
' Name: CWinZip
'
' Description: This is a class module that acts as a wrapper for using VBA to
' manipulate WinZip
'
' Programmer: Scott Lyerly
' Contact: scott.c.lyerly@gmail.com
'
' Notes: None
'
' Bugs: None identified.
'
' Change Log:
' Date Author Version Action
'---------------------------------------------------------------------------------------
' 22-JAN-2014 Scott Lyerly 1.0 Original development
'
Option Explicit
'**************************************************************
' Constant, variables, and other declarations
'**************************************************************
' Constant declarations.
Private Const gsWINZIP_PROGRAM As String = "C:\Program Files\WinZip\winzip32"
Private Const gsDOUBLE_QUOTE As String = """"
Private Const gsSPACE As String = " "
' Enumerations for Winzip Action.
Public Enum gwzActionType
wzAdd
wzFreshen
wzUpdate
wzMove
wxExtract
End Enum
' Variable declarations.
Private msWinZipFile As String
Private msZippedFile As String
Private mcolZippedFiles As Collection
Private mbOneFile As Boolean
Private msExtractFolder As String
Private mwzAction As gwzActionType
Private mbMinimized As Boolean
Private mbOverwrite As Boolean
'**************************************************************
' Class properties
'**************************************************************
' The archive into which files will be archived (zipped)
Public Property Let WinZipFile(ByVal sWinZipFile As String): msWinZipFile = sWinZipFile: End Property
Public Property Get WinZipFile() As String: WinZipFile = msWinZipFile: End Property
' The folder to extract files to.
Public Property Let ExtractFolder(ByVal sExtractFolder As String): msExtractFolder = sExtractFolder: End Property
Public Property Get ExtractFolder() As String: ExtractFolder = msExtractFolder: End Property
' The action type being used by Winzip
Public Property Let ActionType(ByVal wzAction As gwzActionType): mwzAction = wzAction: End Property
Public Property Get ActionType() As gwzActionType: ActionType = mwzAction: End Property
' Whether Winzip will run minimized so it's mostly hidden from view.
Public Property Let Minimized(ByVal bMinimized As Boolean): mbMinimized = bMinimized: End Property
Public Property Get Minimized() As Boolean: Minimized = mbMinimized: End Property
' Whether the files to be unzipped will overwrite an existing files in the extract location of the same name.
Public Property Let Overwrite(ByVal bOverwrite As Boolean): mbOverwrite = bOverwrite: End Property
Public Property Get Overwrite() As Boolean: Overwrite = mbOverwrite: End Property
' These properties are for zipping a singel file.
Public Property Let ZippedFile(ByVal sZippedFile As String):
msZippedFile = sZippedFile
mbOneFile = True
End Property
Public Property Get ZippedFile() As String: ZippedFile = msZippedFile: End Property
' These properties are for zipping multiple files.
Public Property Let ZippedFiles(colZippedFiles As Collection)
Set mcolZippedFiles = colZippedFiles
mbOneFile = False
End Property
Public Property Get ZippedFiles() As Collection: ZippedFiles = mcolZippedFiles: End Property
'**************************************************************
' Class methods and functions
'**************************************************************
Public Function ZipFile() As Long
'*******************************************************************************
' Description: This is used to zip (compress) a file into an archive.
'
' Author: Scott Lyerly
' Contact: scott.c.lyerly@gmail.com
'
' Name: Date: Init: Modification:
' ZipFile 22-JAN-2014 SCL Original development
'
' Arguments: None
'
' Returns: Long Value returned as part of the Shell function
'*******************************************************************************
On Error GoTo ErrHandler:
Dim sShellString As String
Dim i As Integer
Dim sFiles As String
' Check first for both the file to be zipped
' and the archive in which to zip the file.
If Not Exists(msWinZipFile) Then Exit Function
If Not Exists(msZippedFile) Then Exit Function
' Set string for the Winzip program.
sShellString = gsWINZIP_PROGRAM & gsSPACE
' Minimized, if applicable.
If Minimized Then sShellString = sShellString & "-min" & gsSPACE
' Check the Action type to make sure we're not trying to zip and unzip at the same time.
If ActionType = wxExtract Then Exit Function
sShellString = sShellString & GetAction(ActionType) & gsSPACE
' Set the string for the Zip archive.
sShellString = sShellString & gsDOUBLE_QUOTE & msWinZipFile & gsDOUBLE_QUOTE & gsSPACE
' Set the File(s) to archive.
If mbOneFile = True Then
' Set this string if it's only one file.
sFiles = gsDOUBLE_QUOTE & msZippedFile & gsDOUBLE_QUOTE
Else
'Interate through the collection if it's multiple files to archive.
For i = 1 To mcolZippedFiles.Count
If Not Exists(mcolZippedFiles(i)) Then Exit Function
sFiles = sFiles & gsDOUBLE_QUOTE & mcolZippedFiles(i) & gsDOUBLE_QUOTE & gsSPACE
Next i
End If
sShellString = sShellString & sFiles
' Execute the command line.
ZipFile = Shell(sShellString)
ExitClean:
Exit Function
ErrHandler:
ZipFile = Err.Number
End Function
Public Function UnZipFile() As Long
'*******************************************************************************
' Description: This is used to zip (compress) a file into an archive.
'
' Author: Scott Lyerly
' Contact: scott.c.lyerly@gmail.com
'
' Name: Date: Init: Modification:
' UnZipFile 22-JAN-2014 SCL Original development
'
' Arguments: None
'
' Returns: Long success = returns the task ID of the program started with the Shell
' failure = returns the error number
'*******************************************************************************
Dim sShellString As String
If Not Exists(msWinZipFile) Then Exit Function
If Not Exists(msExtractFolder) Then Exit Function
' Winzip program
sShellString = gsWINZIP_PROGRAM & gsSPACE
' Action
If ActionType <> wxExtract Then Exit Function
sShellString = sShellString & GetAction(ActionType) & gsSPACE
' Overwrite option
If mbOverwrite Then sShellString = sShellString & "-o" & gsSPACE
' Zip file
sShellString = sShellString & gsDOUBLE_QUOTE & msWinZipFile & gsDOUBLE_QUOTE & gsSPACE
' Folder to extract to.
sShellString = sShellString & gsDOUBLE_QUOTE & msExtractFolder & gsDOUBLE_QUOTE
' Execute the command line.
UnZipFile = Shell(sShellString)
End Function
Private Function GetAction(wzAction As gwzActionType) As String
'*******************************************************************************
' Description: Returns the Action Type to routines internal to this class only.
'
' Author: Scott Lyerly
' Contact: scott.c.lyerly@gmail.com
'
' Name: Date: Init: Modification:
' GetAction 22-JAN-2014 SCL Original development
'
' Arguments: Action Type enumeration
'
' Returns: String: converts the action type to a string to be used in the
' zipping or unzipping command line string.
'*******************************************************************************
Select Case wzAction
Case wzAdd: GetAction = "-a" 'default
Case wzFreshen: GetAction = "-f"
Case wzUpdate: GetAction = "-u"
Case wzMove: GetAction = "-m"
Case wxExtract: GetAction = "-e"
End Select
End Function
Private Function Exists(sFile As String)As Boolean
'*******************************************************************************
' Description: This check to ensure that a file exists.
'
' Author: Scott Lyerly
' Contact: scott.c.lyerly@gmail.com
'
' Name: Date: Init: Modification:
' Exists 22-JAN-2014 SCL Original development
'
' Arguments: sFile (string): the file for which we're checking existence.
'
' Returns: Boolean
'*******************************************************************************
On Error Resume Next
Exists = (Len(Dir$(sFile)) > 0)
If Err.Number <> 0 Then
Exists = False
End If
End Function
Private Sub Class_Initialize()
'*******************************************************************************
' Description: This runs when the class is created.
'*******************************************************************************
Set mcolZippedFiles = New Collection
mbOneFile = False
mbMinimized = True
mbOverwrite = False
End Sub
Private Sub Class_Terminate()
'*******************************************************************************
' Description: This runs when the class is destroyed
'*******************************************************************************
Set mcolZippedFiles = Nothing
End Sub
Scott Lyerly 