I work for a company that makes industrial secondary packaging machines. (Our machines put stuff in cardboard cases.)
The machine can run several different sets of parameters for various product and case combinations, each set of parameters is called a "recipe."
The parameters are entered in an Excel spreadsheet, and by using VBA code, the parameters are formatted into a single .CSV file for each "recipe" and sent to the controller.
I am working on making improvements to this VBA code. We are trying a process where all the "recipes" are sent in a compressed ZIP file. The following code is for compressing and uncompressing the ZIP "archives."
Option Explicit #If VBA7 And Win64 Then Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr) 'For 64 Bit Systems #Else Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) 'For 32 Bit Systems #End If Function CreateArchive(folderPath As String) As String If PrintDebug Then Debug.Print "CreateArchive(folderPath As String) As String" ' ' This creates a recipe archive that is ready to send to the controller. ' The recipe archive is a Zip file with CSV files inside a \user\data directory. ' The Zip file being created will be in the same parent directory ' as the directory passed to the function, with the same file name as the directory ' (akin to creating an Zip file in Windows Explorer.) ' Dim archivePath As String Dim tempFolderPath As String Dim fso As Scripting.FileSystemObject Set fso = New FileSystemObject Application.StatusBar = "Creating the recipe archive..." ' Check for unnecessary trailing slash in folderPath If Right(folderPath, 1) = "\" Then folderPath = Left(folderPath, Len(folderPath) - 1) End If If Not fso.FolderExists(folderPath) Then 'error End If If fso.FolderExists(folderPath & "\user") Then fso.DeleteFolder (folderPath & "\user") End If fso.CreateFolder folderPath & "\user" fso.CreateFolder folderPath & "\user\data" ' Copy the recipes into the \user\data folder ' This leaves the orgninals in the root CSV folder, mimmicing the Pre-v21 behavior. fso.CopyFile folderPath & "\Rcp*.csv", folderPath & "\user\data", OverWriteFiles:=True ' Create an empty ZIP file archivePath = folderPath & ".zip" fso.CreateTextFile(archivePath, True).Write _ "PK" & Chr(5) & Chr(6) & String(18, vbNullChar) ' Copy the \user folder into the ZIP file using the Windows Shell Dim shellApp As Object 'Shell32.Shell Set shellApp = CreateObject("Shell.Application") shellApp.Namespace(CVar(archivePath)).CopyHere shellApp.Namespace(CVar(folderPath & "\user")) waitForArchiveReady (archivePath) ' Redundant check to see if the .MoveHere is finished ' Do Until Not fso.FolderExists(folderPath & "\user") ' DoEvents ' Application.Wait (Now + TimeValue("0:00:01")) ' Loop CreateArchive = archivePath ExitProc: Set fso = Nothing Set shellApp = Nothing Exit Function ErrHandler: Select Case Err.Number Case Else MsgBox "Error " & Err.Number & _ ": " & Err.Description, _ vbCritical, "Unexpected error" End Select Resume ExitProc Resume End Function Function UnzipArchive(archivePath As String, targetFolderPath As String) As Boolean If PrintDebug Then Debug.Print "UnzipArchive(archivePath As String, targetFolderPath As String) As Boolean" UnzipArchive = False Dim fso As Scripting.FileSystemObject Set fso = New Scripting.FileSystemObject If fso.FolderExists(targetFolderPath) Then fso.DeleteFolder (targetFolderPath) fso.CreateFolder targetFolderPath ' Copy from the zip file to the temp target folder Dim shellApp, objSource, ObjTarget As Object Set shellApp = CreateObject("Shell.Application") Sleep 500 Set objSource = shellApp.Namespace(CVar(archivePath & "\user\data")) Set ObjTarget = shellApp.Namespace(CVar(targetFolderPath)) ObjTarget.CopyHere objSource.Items waitForArchiveReady (archivePath) UnzipArchive = True End Function Private Function waitForArchiveReady(path As String) If PrintDebug Then Debug.Print "Function waitForArchiveReady(path As String)" ' ' Test to see if Shell.Application is finished working with the ZIP archive ' by trying to Open the archive file with exclusive write access. ' The theory is that if the Shell is reading or writing the zip file, ' the Shell will lock it to prevent another task from writing in it at the same time. ' ' This is "try" loop that repeats until successful. ' Commented lines are for converting to a function that tries once and returns a boolean. ' ' Sleep 500ms. VBA execution may be here before the Shell ' has opened the ZIP file for reading/writing. ' Hopefully it doesn't take this long otherwise we return control ' to the parent subroutine and continue execution before ' the ZIP access has even begun. If PrintDebug Then Debug.Print "Sleep 500ms (initial)" Sleep 500 Try: On Error GoTo Fail Open path For Random Access Read Lock Read Write As #1 GoTo Success Resume CleanExit Fail: ' our likely result for the inital loop through waitForArchiveReady If Err.Number = 55 Then 'if file is already opened, exit GoTo Success End If If PrintDebug Then Debug.Print "Sleep 200ms" Sleep 200 On Error GoTo 0 'reset our error handler Resume Try ' try again Success: 'waitForArchiveReady = True CleanExit: ' Clean Close #1 Sleep 1000 End Function
I am looking for any feedback that anyone may be able to give. I've been programming in VBA for about two years, but I have never had my code peer-reviewed. I'd like any advice anyone may give, especially in the areas of optimization or semantics.
Or, if anybody could come up with a better way of doing this. Next best option that I have come across is using a third-party DLL, but that is unacceptable as this program needs to run on various computers for many different customers.