Create Zip File From Folder

Date: 02-16-2022

Return to Index

 
'Credit: William Burns
 
'==================================================
'  CreateZipFile - creates a zip file from a folder
'==================================================
'Compilable Example:  (Jose Includes)
#Compile Exe
#Dim All
#Debug Error On
#Debug Display On
#Include "win32api.inc"
#Include "WinShell.inc"  'created by the PowerBasic Com browser on Shell32 lib
 
Function PBMain() As Long
   CreateZipFileFromFolder "C:\test", "c:\data\test_zip.zip"
End Function
 
Function CreateZipFileFromFolder(ByVal sFrom As String, ByVal sTo As String) As Long
   Local hFile       As Dword
   'Object Variables
   Dim oShellClass      As IShellDispatch
   Dim oSourceFolder    As Folder
   Dim oTargetFolder    As Folder
   Dim oItems        As FolderItems
   'variants
   Dim vSourceFolder   As Variant
   Dim vTargetFolder   As Variant
   Dim vOptions       As Variant
 
 
 
   'First we create a empty ZIP file using a standard zip file header
   Try
      hFile = FreeFile
      Open sTo For Output As #hFile
      Print #hFile, Chr$(80,75,5,6,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0)
      Close #hFile
   Catch
      MsgBox "Error creating Zip file.",,Error$(Err)
      Exit Function
   End Try
 
 
   ' Get an instance of our Windows Shell
   oShellClass = AnyCom $PROGID_SHELL32_SHELL
 
   ' Did we get the object? If not, terminate this app
   If IsFalse IsObject(oShellClass) Or Err Then
      MsgBox "Could not get the Windows Shell object.",,"Error:" & Str$(Err)
      Exit Function
   End If
 
 
   'assign the source folder we want to zip up
   vSourceFolder = sFrom
   oSourceFolder = oShellClass.NameSpace(vSourceFolder)
 
   If IsFalse IsObject(oSourceFolder) Or Err Then
      MsgBox "Could not get the Source folder object.",,"Error:" & Str$(Err)
      GoTo Terminate
   End If
 
 
   'assign the target folder we want to create (in this case it is a zip file)
   vTargetFolder = sTo
   oTargetFolder = oShellClass.NameSpace(vTargetFolder)
 
   If IsFalse IsObject(oTargetFolder) Or Err Then
      MsgBox "Could not get the Target folder object.",,"Error:" & Str$(Err)
      GoTo Terminate
   End If
 
 
   'assign all the items in the source folder to the Items object
   oItems = oSourceFolder.Items()
 
 
 
   If IsFalse IsObject(oItems) Or Err Then
      MsgBox "Could not get the Items object.",,"Error:" & Str$(Err)
      GoTo Terminate
   End If
 
   'now we start the copy in to the new zip file
   vOptions = 20
   oTargetFolder.CopyHere(oItems, vOptions)
 
   If Err Then
      MsgBox "Got an Error during the CopyHere method.",,"Error:" & Str$(Err)
      GoTo Terminate
   End If
 
      'NOTE:  the above copyhere method starts a seperate thread to do the copy
      'so the command could return before the copy is finished, so we need to
      'allow time to complete.   Thus the next Sleep command.
   Sleep 2000  'increase for larger folders
 
   MsgBox "All done! Now wasn't that easy?",,"Windows Zip"
 
   Terminate:
 
   ' Close all of the Interfaces
   oItems = Nothing
   oTargetFolder  = Nothing
   oSourceFolder  = Nothing
   oShellClass  = Nothing
 
 
 
End Function  
 
'gbs_01269
'Date: 05-11-2013

created by gbSnippets
http://www.garybeene.com/sw/gbsnippets.htm