Zipping folders with vba (1 Viewer)

yaya

Registered User.
Local time
Yesterday, 22:25
Joined
Dec 4, 2018
Messages
18
Hello,

I have a folder that at the root level contains both files as well as an images folder containing .jpg files. I was wondering if it were possible to use VBA to create a .zip file from that root folder. So far, I have only been able to create a new .zip file, and then add files to that .zip. I've had no luck be able to create the images subfolder.

Is this possible with VBA? I have searched many forums and have found the following code to be one of few that actually runs without throwing an error:

Code:
Sub AddFolderToZip(ZipFile As String, FolderToAdd As String)

Dim objShell As Object
Dim lngFilesAdded As Long
Dim strFile As String
Dim varZipFile As Variant

  Call InitializeZipFile(ZipFile) 'This Works

  Set objShell = _
    CreateObject("Shell.Application")

  varZipFile = ZipFile

  If Right$(FolderToAdd, 1) <> "\" Then
    FolderToAdd = FolderToAdd & "\"
  End If

  strFile = Dir(FolderToAdd & "*.*")

  Do While strFile <> ""
    
    'This doesnt capture the subfolder inside the folder to add
    objShell.Namespace(varZipFile).CopyHere (FolderToAdd & strFile)
    lngFilesAdded = lngFilesAdded + 1

    Do Until _
      objShell.Namespace(varZipFile).Items.Count >= lngFilesAdded
      Call Pause(1)
    Loop

    strFile = Dir()
  Loop
End Sub
 
Last edited:

June7

AWF VIP
Local time
Yesterday, 21:25
Joined
Mar 9, 2014
Messages
5,424
This works for me:
Code:
Sub CreateZipFile()
Dim folderToZipPath As Variant, zippedFileFullName As Variant
folderToZipPath = "C:\Photo"
zippedFileFullName = "C:\Users\June\Test.zip"
Dim ShellApp As Object
'Create an empty zip file
Open zippedFileFullName For Output As #1
Print #1, Chr$(80) & Chr$(75) & Chr$(5) & Chr$(6) & String(18, 0)
Close #1
'Copy the files & folders into the zip file
Set ShellApp = CreateObject("Shell.Application")
'ShellApp.Namespace(zippedFileFullName).CopyHere ShellApp.Namespace(folderToZipPath).Items 'copies only items within folder
ShellApp.Namespace(zippedFileFullName).CopyHere folderToZipPath 'copies folder and its contents
 
Last edited:

shadow9449

Registered User.
Local time
Today, 01:25
Joined
Mar 5, 2004
Messages
1,037
This works for me:
Code:
Sub CreateZipFile()
Dim folderToZipPath As Variant, zippedFileFullName As Variant
folderToZipPath = "C:\Photo"
zippedFileFullName = "C:\Users\June\Test.zip"
Dim ShellApp As Object
'Create an empty zip file
Open zippedFileFullName For Output As #1
Print #1, Chr$(80) & Chr$(75) & Chr$(5) & Chr$(6) & String(18, 0)
Close #1
'Copy the files & folders into the zip file
Set ShellApp = CreateObject("Shell.Application")
'ShellApp.Namespace(zippedFileFullName).CopyHere ShellApp.Namespace(folderToZipPath).Items 'copies only items within folder
ShellApp.Namespace(zippedFileFullName).CopyHere folderToZipPath 'copies folder and its contents

Pretty awesome! I tried it and it works. Does anyone know if there's a way to alter the code to put a password on the zip archive?
 

June7

AWF VIP
Local time
Yesterday, 21:25
Joined
Mar 9, 2014
Messages
5,424
If you do use another app to zip files, make sure users receiving your zip can still open it. IIRC, WindowsCompression can't open some compressed files, such as rar and 7zip.
 

shadow9449

Registered User.
Local time
Today, 01:25
Joined
Mar 5, 2004
Messages
1,037
If you do use another app to zip files, make sure users receiving your zip can still open it. IIRC, WindowsCompression can't open some compressed files, such as rar and 7zip.

Agreed but you can always zip it into a .zip
 

Number11

Member
Local time
Today, 05:25
Joined
Jan 29, 2020
Messages
607
Does any one know how to change this code to only run if the folder contains files?
 

Users who are viewing this thread

Top Bottom