Handle cabinet files and folders with VBA the Windows Explorer way

Gustav BrockMVP
CERTIFIED EXPERT
Published:
Updated:
Windows Explorer lets you open cabinet (cab) files like any other folder.
In VBA you can easily handle normal files and folders, but opening and indeed creating cabinet files takes a lot more - and that's you'll find here.

Ease of use

The goal is to read and create cabinet folders with no third-party tools or libraries that are not already present in the user's machine. As you will see, Windows Explorer on its own can help us read a cabinet file, but it cannot create such a file. However, Windows comes with a native command line utility, makecab.exe , which we will use to create a cabinet folder.


There are many uses for cabinet folders. Previously, a saving in disk space was the primary purpose, indeed for creating installation disks and cd-roms, but today that often isn't very important; the option for collecting a selection of files in one file may be more pertinent.


In most cases it will be more convenient to use zip folders, as these can preserve subfolders and be modified after creation, should you later wish to – for example, one file inside a zip folder can be updated like a file in a normal folder. Once a cabinet file is created, that's it.


On the other hand, a cabinet folder can compress certain file types (like bitmap pictures and database files) much better than a zip folder can. And the fact, that the content of a cabinet folder is read-only, may in some cases be an advantage.


However, for whatever reason or purpose you may have for using a cabinet folder (or a file as it physically is) that is controlled by VBA code in, say, Microsoft Excel or Microsoft Access, it should be easy to manage.


Several external third-party tools and libraries are offered, and each may have certain advantages. An example is the utility from Microsoft, cabarc.exe , which can preserve subfolders in the cabinet folder, but for the general usage - reading cabinet folders (as Windows Explorer does) and creating them - you only need the two functions presented here: Cab and DeCab - nothing more, nothing less.


Note: Zip  and archive  files/folders can be managed in a similar way. If you are interested in this, please see:


Zip and unzip files and folders with VBA the Windows Explorer way

Handle archive files and folders with VBA the Windows Explorer way



Cab and DeCab

These two functions are included in the VBA API and does just as if you did it manually on screen using Windows Explorer.


They can do a little more, controlled by the parameters as explained below, and will also work with custom file extensions, should you have the need. Thus, a cabinet folder may be named, say, mycabfolder.bab . This will prevent the file from being recognized by Windows Explorer as a cabinet folder.


For large and/or many files, the well-known progress bar box will be displayed when copying from a cabinet folder. When creating a cabinet folder, in addition to the hourglass, a minimized command window runs, which can be restored if one wishes to follow the progress.


Cab

Result = Cab(Path)

This compress Path (a file or a folder's files). This would be similar to using Windows Explorer to right-clicked the file or folder and selected Send to cabinet folder (which you can't). 


Result holds 0 (zero) for success, or an error code.


For many practical purposes, you may wish to specify where the cabinet folder will be created and what name it should be given. Thus:

Destination = "D:\Backups\Data_20171224.cab"
Result = Cab(Path, Destination)


Should you wish so, the extension can be different from cab, for example:

Destination = "D:\Backups\Data_20171224.cak"


Also you are probably aware, that if you in Windows Explorer tried to zip the same file or folder again, Windows Explorer will generate a "versioned" zip file. Function Cab mimics this by extending filenames like:

D:\Backups\Data_20171224.cab 
D:\Backups\Data_20171224 (2).cab
D:\Backups\Data_20171224 (3).cab 

and so on.


If you don't want this, a third parameter is available, Overwrite. Thus, if the destination exists:

Result = Cab(Path, , True)     ' Delete and recreate the zip folder.
Result = Cab(Path, , False)    ' Create a versioned zip folder.


Further, a common style for a cabinet folder holding a single file is to replace the last character of the file extension with an underscore. To do so, set the parameter SingleFileExtension to True:

Result = Cab(Path, , , True)   ' Create cabinet file with single-file extension.


If Path is not a single file, parameter SingleFileExtension will be ignored, and the standard cabinet extension will be used.


Finally, compression can be set to standard or high (default). High compression can be very effective – often with a reduction of the compressed file size of about 30 - 50%, compared to standard compression. A cabinet folder with standard compression will have a size similar to that obtained for a zip folder.


A typical Microsoft Access database file could be compressed like this:


Uncompressed
32.0 MB
Compressed, low
5.8 MB
Compressed, high
4.0 MB


The penalty for using high compression is compression speed. It is about 50% slower. The decompression time it about the same, regardless of the compression used.


DeCab

Result = DeCab(Path)

This decompress Path (a cabinet folder) like if you, in Windows Explorer, double-click the cabinet folder and copied all the contained files to the parent folder. 


Result holds 0 (zero) if success, or an error code.


Often, you wish to specify where the cabinet folder will be decompressed and/or what name the folder should be given. If so, specify the Destination parameter:

Destination = "D:\Restore\Data" 
Result = DeCab(Path, Destination)


By default, if decompressing to an existing folder, DeCab will overwrite the existing folder completely. Setting parameter Overwrite to False will leave existing files, but will overwrite those with the same name as the files in the cabinet folder:

Result = DeCab(Path, , True)     ' Delete and recreate the folder.
Result = DeCab(Path, , False)    ' Leave existing files in thefolder. 

Warning

Be careful and double-check before calling DeCab with Overwrite set to True (default).

If Destination is specified wrongly, you may inadvertently erase most of a drive.


Code

Both Cab and DeCab takes advantage of two standard Microsoft libraries found on any Windows machine:


Microsoft Shell Controls And Automation 

Microsoft Scripting Runtime


and both functions allow for early or late binding as you prefer, controlled by the constant EarlyBinding that you can adjust to your preference.


There are many more details to take care of than one might expect, thus a lot of comments are outlined here to study for those that are interested. But don't feel obliged; the functions are ready to use as is.


Cab

This is the full function:

' Compress a file or a folder to a cabinet file/folder.
'
' A single file will be compressed to a file with a ".*_" extension by default,
' optionally with a ".cab" extension.
' A folder will be compressed to a file with a ".cab" extension by default,
' optionally with a custom extension.
'
' Parameters:
'   Path:
'       Valid (UNC) path to the file or folder to compress.
'   Destination:
'       (Optional) Valid (UNC) path to a folder or to a file with a
'       cabinet extension or other extension.
'   Overwrite:
'       (Optional) Overwrite (default) or leave an existing cabinet file.
'       If False, the created cabinet file will be versioned:
'           Example.cab, Example (2).cab, etc.
'       If True, an existing cabinet file will first be deleted, then recreated.
'   SingleFileExtension:
'       (Optional) ".*_" style or (default) ".cab" file extension.
'       If False, the created cabinet file extension will be "cab".
'       If True and source file's extension's last character is not an underscore,
'       the created cabinet file extension will be named as the source file,
'       but with an underscore as the last character of the extension.
'       In both cases, a specified Destination filename will override this setting.
'   HighCompression:
'       (Optional) Use standard compression or high compression.
'       If False, use standard MSZIP compression. Faster, but larger file size.
'       If True, use LZX compression. Slower, but smaller file size.
'
'   Path and Destination can be relative paths. If so, the current path is used.
'
'   If success, 0 is returned, and Destination holds the full path of the created cabinet file.
'   If error, error code is returned, and Destination will be zero length string.
'
' Early binding requires references to:
'
'   Shell:
'       Microsoft Shell Controls And Automation
'
'   Scripting.FileSystemObject:
'       Microsoft Scripting Runtime
'
' 2022-04-20. Gustav Brock. Cactus Data ApS, CPH.
'
Public Function Cab( _
    ByVal Path As String, _
    Optional ByRef Destination As String, _
    Optional ByVal OverWrite As Boolean = True, _
    Optional ByVal SingleFileExtension As Boolean, _
    Optional ByVal HighCompression As Boolean = True) _
    As Long
    
#If EarlyBinding Then
    ' Microsoft Scripting Runtime.
    Dim FileSystemObject    As Scripting.FileSystemObject
    ' Microsoft Shell Controls And Automation.
    Dim ShellApplication    As Shell
    
    Set FileSystemObject = New Scripting.FileSystemObject
    Set ShellApplication = New Shell
#Else
    Dim FileSystemObject    As Object
    Dim ShellApplication    As Object

    Set FileSystemObject = CreateObject("Scripting.FileSystemObject")
    Set ShellApplication = CreateObject("Shell.Application")
#End If
    
    ' Extension of a cabinet file holding one or more files.
    Const CabExtensionName  As String = "cab"
    Const CabExtension      As String = "." & CabExtensionName
    ' Extension of a cabinet file holding one file only.
    Const CabExtensionName1 As String = "*_"
    ' Extension for a Disk Directive File for MakeCab.exe.
    Const DdfExtensionName  As String = "ddf"
    Const DdfExtension      As String = "." & DdfExtensionName
    ' Custom error values.
    Const ErrorPathFile     As Long = 75
    Const ErrorOther        As Long = -1
    Const ErrorNone         As Long = 0
    ' Maximum (arbitrary) allowed count of created cabinet versions.
    Const MaxCabVersion     As Integer = 1000
    
    ' MakeCab directive constants.
    Const CompressionHigh   As String = "LZX"
    Const CompressionLow    As String = "MSZIP"
    
    Dim FileNames           As Variant
    
    Dim CabPath             As String
    Dim CabName             As String
    Dim CabFile             As String
    Dim CabBase             As String
    Dim CabTemp             As String
    Dim CabMono             As Boolean
    Dim Extension           As String
    Dim ExtensionName       As String
    Dim Version             As Integer
    Dim Item                As Long
    Dim PathName            As String
    Dim CurrentDirectory    As String
    Dim TempDirectory       As String
    Dim Result              As Long
    
    If FileSystemObject.FileExists(Path) Then
        ' The source is an existing file.
        CabMono = True
        CabName = FileSystemObject.GetFileName(Path)
        If SingleFileExtension = True Then
            ExtensionName = FileSystemObject.GetExtensionName(Path)
            ' Check if the file already has a cabinet-style extension.
            If Right(ExtensionName, 1) = Right(CabExtensionName1, 1) Then
                ' Remove extension.
                ExtensionName = ""
                ' Add cabinet extension later.
            Else
                ' Apply cabinet-style extension.
                Mid(CabName, Len(CabName)) = Right(CabExtensionName1, 1)
                ExtensionName = FileSystemObject.GetExtensionName(CabName)
            End If
        End If
        If ExtensionName = "" Then
            CabName = FileSystemObject.GetBaseName(Path) & CabExtension
            ExtensionName = FileSystemObject.GetExtensionName(CabName)
        End If
        CabPath = FileSystemObject.GetFile(Path).ParentFolder
        Extension = "." & ExtensionName
    ElseIf FileSystemObject.FolderExists(Path) Then
        ' The source is an existing folder or fileshare.
        CabBase = FileSystemObject.GetBaseName(Path)
        If CabBase <> "" Then
            ' Path is a folder.
            CabName = CabBase & CabExtension
            CabPath = FileSystemObject.GetFolder(Path).ParentFolder
            Extension = CabExtension
        Else
            ' Path is a fileshare, thus has no parent folder.
        End If
    Else
        ' The source does not exist.
    End If
       
    If CabName = "" Then
        ' Nothing to compress. Exit.
        Destination = ""
    Else
        If Destination <> "" Then
            If FileSystemObject.GetExtensionName(Destination) = "" Then
                ' Destination is a folder.
                If FileSystemObject.FolderExists(Destination) Then
                    CabPath = Destination
                Else
                    ' No folder for the cabinet file. Exit.
                    Destination = ""
                End If
            Else
                ' Destination is a single compressed file.
                CabName = FileSystemObject.GetFileName(Destination)
                If CabName = Destination Then
                    ' No path given. Use CabPath as is.
                Else
                    ' Use path of Destination.
                    CabPath = FileSystemObject.GetParentFolderName(Destination)
                End If
            End If
        Else
            ' Use the already found folder of the source.
            Destination = CabPath
        End If
    End If
    
    If Destination <> "" Then
        CabFile = FileSystemObject.BuildPath(CabPath, CabName)
        
        If FileSystemObject.FileExists(CabFile) Then
            If OverWrite = True Then
                ' Delete an existing file.
                FileSystemObject.DeleteFile CabFile, True
                ' At this point either the file is deleted or an error is raised.
            Else
                CabBase = FileSystemObject.GetBaseName(CabFile)
                ExtensionName = FileSystemObject.GetExtensionName(CabFile)
                If ExtensionName <> CabExtensionName Then
                    Extension = "." & ExtensionName
                End If
                ' Modify name of the cabinet file to be created to preserve an existing file:
                '   "Example.cab" -> "Example (2).cab", etc.
                Version = Version + 1
                Do
                    Version = Version + 1
                    CabFile = FileSystemObject.BuildPath(CabPath, CabBase & Format(Version, " \(0\)") & Extension)
                Loop Until FileSystemObject.FileExists(CabFile) = False Or Version > MaxCabVersion
                If Version > MaxCabVersion Then
                    ' Give up.
                    Err.Raise ErrorPathFile, "Cab Create", "File could not be created."
                End If
                CabName = FileSystemObject.GetFileName(CabFile)
            End If
        End If
        ' Set returned file name.
        Destination = CabFile
        
        ' Get list of files to compress.
        FileNames = FolderFileNames(Path)
        
        ' Prepare a temporary ddf file to control makecab.exe.
        CabTemp = FileSystemObject.BuildPath(CabPath, FileSystemObject.GetBaseName(FileSystemObject.GetTempName()) & DdfExtension)
        ' Resolve relative paths.
        CabTemp = FileSystemObject.GetAbsolutePathName(CabTemp)
        Path = FileSystemObject.GetAbsolutePathName(Path)
        
        ' Build the directive file.
        With FileSystemObject.OpenTextFile(CabTemp, ForWriting, True)
            .Write ".Set CabinetName1=""" & CabName & """" & vbCrLf
            .Write ".Set CompressionMemory=21" & vbCrLf
            .Write ".Set CompressionType=" & IIf(HighCompression, CompressionHigh, CompressionLow) & vbCrLf
            .Write ".Set DiskDirectoryTemplate=""" & CabPath & """" & vbCrLf
            .Write ".Set MaxDiskSize=0" & vbCrLf
            .Write ".Set InfFileName=NUL" & vbCrLf
            .Write ".Set RptFileName=NUL" & vbCrLf
            .Write ".Set UniqueFiles=OFF" & vbCrLf
            .Write ".Set SourceDir=""" & IIf(CabMono, FileSystemObject.GetParentFolderName(Path), Path) & """" & vbCrLf
            ' Append list of files to compress.
            For Item = LBound(FileNames) To UBound(FileNames)
                .Write """" & FileNames(Item) & """" & vbCrLf
            Next
            .Close
        End With
        
        ' Record the current directory.
        CurrentDirectory = CurDir
        ' Change current directory to temp folder.
        TempDirectory = Environ("temp")
        ChDrive TempDirectory
        ChDir TempDirectory

        ' Create the cabinet file.
        PathName = "makecab.exe /v1 /f """ & CabTemp & """"
        ' ShellWait returns True for no errors.
        Result = ShellWait("cmd /c " & PathName & "", vbMinimizedNoFocus)
        
        ' Restore the current directory.
        ChDrive CurrentDirectory
        ChDir CurrentDirectory
        
        ' Delete the directive file.
        FileSystemObject.DeleteFile CabTemp, True
    End If
    
    Set ShellApplication = Nothing
    Set FileSystemObject = Nothing
    
    If Err.Number <> ErrorNone Then
        Destination = ""
        Result = Err.Number
    ElseIf Destination = "" Then
        Result = ErrorOther
    End If
    
    Cab = Result

End Function

It is heavily commented in-line, but the key points are:


  1. Verifies the source
  2. Verifies the destination
  3. Creates the directive file for makecab.exe
  4. Copies the files
  5. Performs clean-up


The core code is this (shortened) which copies the file(s) into the cabinet folder:

        PathName= "makecab.exe /v1 /f """ & CabTemp &""""
        Result =ShellWait("cmd /c " & PathName & "", vbMinimizedNoFocus)

What actually happens is controlled by a directive file  (CabTemp), which has been created in advance by this code snippet:

       With FileSystemObject.OpenTextFile(CabTemp, ForWriting, True)
           .Write ".Set CabinetName1=""" & CabName & """" & vbCrLf
           .Write ".SetCompressionMemory=21" & vbCrLf
           .Write ".Set CompressionType=" & IIf(HighCompression, CompressionHigh, CompressionLow) & vbCrLf
           .Write ".Set DiskDirectoryTemplate=""" & CabPath & """" & vbCrLf
           .Write ".Set MaxDiskSize=0" & vbCrLf
           .Write ".Set InfFileName=NUL" & vbCrLf
           .Write ".Set RptFileName=NUL" & vbCrLf
           .Write ".Set UniqueFiles=OFF" & vbCrLf
           .Write ".Set SourceDir=""" & IIf(CabMono, FileSystemObject.GetParentFolderName(Path), Path) & """" & vbCrLf
           ' Append list of files to compress.
           For Item = LBound(FileNames) To UBound(FileNames)
               .Write """" & FileNames(Item) & """" & vbCrLf
           Next
           .Close
       End With


You will notice the SourceDir specification and - before the Close command - that the list of files are appended. The syntax of the file and the purpose of these directives (commands) are beyond the scope of this article, but the original documentation from Microsoft (35 pages) is attached, and the current on-line documentation can be found here for further study:


Microsoft MakeCAB User's Guide


A problem however, is that if we just called the makecab command, the code would continue at once, not waiting for makecab to finish compressing the files, and we have some clean-up to do afterwards.


Thus, a helper function, ShellWait , is used to make the call. It will make the code wait until the cabinet folder is ready and, only when it is, to continue.


In the case where the parameter Overwrite is False and the cabinet folder exists, a new file will be created and given a version number.

That is controlled by this loop:

CabBase = FileSystemObject.GetBaseName(CabFile)
' Modify name ofthe cabinet file to be created to preserve an existing file:
'   "Example.cab" -> "Example(2).cab", etc.
Version = Version + 1
Do
    Version = Version + 1
    CabFile = FileSystemObject.BuildPath(CabPath, CabBase & Format(Version, "\(0\)") & Extension)
Loop Until FileSystemObject.FileExists(CabFile) = False Or Version > MaxCabVersion
If Version > MaxCabVersion Then
    ' Give up.
    Err.Raise ErrorPathFile, "Cab Create", "File could not be created."
End If

As you will see, a maximum count is used to prevent the loop from going on forever.


DeCab

This is the full function:

' Extract files from a cabinet file to a folder using Windows Explorer.
'
' Parameters:
'   Path:
'       Valid (UNC) path to a valid cabinet file. Extension can be another than "cab".
'   Destination:
'       (Optional) Valid (UNC) path to the destination folder.
'   Overwrite:
'       (Optional) Overwrite (default) or leave an existing folder.
'       If False, an existing folder will keep other files than those in the extracted cabinet file.
'       If True, an existing folder will first be deleted, then recreated.
'
'   Path and Destination can be relative paths. If so, the current path is used.
'
'   If success, 0 is returned, and Destination holds the full path of the created folder.
'   If error, error code is returned, and Destination will be zero length string.
'
' Early binding requires references to:
'
'   Shell:
'       Microsoft Shell Controls And Automation
'
'   Scripting.FileSystemObject:
'       Microsoft Scripting Runtime
'
' 2023-10-28. Gustav Brock. Cactus Data ApS, CPH.
'
Public Function DeCab( _
    ByVal Path As String, _
    Optional ByRef Destination As String, _
    Optional ByVal OverWrite As Boolean = True) _
    As Long
    
#If EarlyBinding Then
    ' Microsoft Scripting Runtime.
    Dim FileSystemObject    As Scripting.FileSystemObject
    ' Microsoft Shell Controls And Automation.
    Dim ShellApplication    As Shell
    
    Set FileSystemObject = New Scripting.FileSystemObject
    Set ShellApplication = New Shell
#Else
    Dim FileSystemObject    As Object
    Dim ShellApplication    As Object

    Set FileSystemObject = CreateObject("Scripting.FileSystemObject")
    Set ShellApplication = CreateObject("Shell.Application")
#End If
               
    ' Extension of a cabinet file holding one or more files.
    Const CabExtensionName  As String = "cab"
    ' Extension of a cabinet file holding one file only.
    Const CabExtensionName1 As String = "??_"
    Const CabExtension      As String = "." & CabExtensionName
    ' Extension of an archive file holding one or more files.
    Const TarExtensionName  As String = "tar"
    ' Extension of a compressed archive file holding one or more files.
    Const TgzExtensionName  As String = "tgz"
    ' Mandatory extension of zip file.
    Const ZipExtensionName  As String = "zip"
    ' Custom error values.
    Const ErrorNone         As Long = 0
    Const ErrorOther        As Long = -1
    
    Dim CabName             As String
    Dim CabPath             As String
    Dim CabTemp             As String
    Dim CabMono             As Boolean
    Dim Result              As Long
    
    If FileSystemObject.FileExists(Path) Then
        ' The source is an existing file.
        CabName = FileSystemObject.GetBaseName(Path)
        CabPath = FileSystemObject.GetFile(Path).ParentFolder
        ' Check if the extension matches that of a cabinet file holding one file only.
        CabMono = FileSystemObject.GetExtensionName(Path) Like CabExtensionName1
    End If
    
    If CabName = "" Then
        ' Nothing to extract. Exit.
        Destination = ""
    Else
        ' Select or create destination folder.
        If Destination <> "" Then
            ' Extract to a custom folder.
            If _
                FileSystemObject.GetExtensionName(Destination) = CabExtensionName Or _
                FileSystemObject.GetExtensionName(Destination) = TarExtensionName Or _
                FileSystemObject.GetExtensionName(Destination) = TgzExtensionName Or _
                FileSystemObject.GetExtensionName(Destination) = ZipExtensionName Then
                ' Do not extract to a folder named *.cab, *.tar, or *.zip.
                ' Strip extension.
                Destination = FileSystemObject.BuildPath( _
                    FileSystemObject.GetParentFolderName(Destination), _
                    FileSystemObject.GetBaseName(Destination))
            End If
        Else
            If CabMono Then
                ' Single-file cabinet.
                ' Extract to the folder of the cabinet file.
                Destination = CabPath
            Else
                ' Multiple-files cabinet.
                ' Extract to a subfolder of the folder of the cabinet file.
                Destination = FileSystemObject.BuildPath(CabPath, CabName)
            End If
        End If
            
        If FileSystemObject.FolderExists(Destination) Then
            If OverWrite = True Then
                ' Delete the existing folder.
                FileSystemObject.DeleteFolder Destination, True
            ElseIf FileSystemObject.GetFolder(Destination).Files.Count > 0 Then
                ' Files exists and should not be overwritten.
                ' Exit.
                Destination = ""
            End If
        End If
        If Destination <> "" Then
            If Not FileSystemObject.FolderExists(Destination) Then
                ' Create the destination folder.
                FileSystemObject.CreateFolder Destination
            End If
        End If
        
        If Not FileSystemObject.FolderExists(Destination) Then
            ' For some reason the destination folder does not exist and cannot be created.
            ' Exit.
            Destination = ""
        ElseIf Destination <> "" Then
            ' Destination folder existed or has been created successfully.
            ' Resolve relative paths.
            Destination = FileSystemObject.GetAbsolutePathName(Destination)
            Path = FileSystemObject.GetAbsolutePathName(Path)
            ' Check file extension.
            If FileSystemObject.GetExtensionName(Path) = CabExtensionName Then
                ' File extension is OK.
                CabTemp = Path
            Else
                ' Rename the cabinet file by adding a cabinet extension.
                CabTemp = Path & CabExtension
                FileSystemObject.MoveFile Path, CabTemp
            End If
            ' Extract files and folders from the cabinet file to the destination folder.
            ' Note, that when copying from a cab file, overwrite flag is ignored.
            ShellApplication.Namespace(CVar(Destination)).CopyHere ShellApplication.Namespace(CVar(CabTemp)).Items
            If CabTemp <> Path Then
                ' Remove the cabinet extension to restore the original file name.
                FileSystemObject.MoveFile CabTemp, Path
            End If
        End If
    End If
    
    Set ShellApplication = Nothing
    Set FileSystemObject = Nothing
    
    If Err.Number <> ErrorNone Then
        Destination = ""
        Result = Err.Number
    ElseIf Destination = "" Then
        Result = ErrorOther
    End If
    
    DeCab = Result
     
End Function

Again, the in-line comments should make it possible to follow what's going on; in essence it performs these steps:


  1. Verifies the source
  2. Verifies the destination
  3. Copies the files
  4. Performs clean-up


Again, the core code is quite simple; it copies the content of the source - the cabinet folder - into the destination folder:

ShellApplication.Namespace(CVar(Destination)).CopyHere ShellApplication.Namespace(CVar(CabTemp)).Items


Contrary to the copying to a cabinet folder (above), this code line waits for the copying to finish and the code will not continue until copying is done.

 

Conclusion

Armed with these two functions, you can control all basic compressing and decompressing of cabinet folders from VBA. No external tools or libraries are used, which makes distributing and deployment easy.

Of course, more advanced options, like encrypting, may be requested, and then third-party tools like WinZip or 7Zip must be used. This is more about cabinet files as we know them from Windows.


Files and download

The complete module and Microsoft Access and Excel 365 files are here: Compress 1.3.0.zip

They will run in both 32- and 64-bit VBA.

Current files can always be found at: GitHub VBA.Compress


Microsoft MakeCABUser’s Guide (1997): MAKECAB.DOC


I hope you found this article useful. You are encouraged to ask questions, report any bugs or make any other comments about it below.


Note: If you need further "Support" about this topic, please consider using the Ask a Question feature of Experts Exchange. I monitor questions asked and would be pleased to provide any additional support required in questions asked in this manner, along with other EE experts.


Please do not forget to press the "Thumbs Up" button if you think this article was helpful and valuable for EE members.


0
3,103 Views
Gustav BrockMVP
CERTIFIED EXPERT

Comments (0)

Have a question about something in this article? You can receive help directly from the article author. Sign up for a free trial to get started.