VBA code to zip file not working

[mp3909]

Hi,

So I found a piece of VBA code online which should zip a file.
This is the code:

 Sub ZipFile(strZipFilePath As String, strZipFileName As String, ParamArray arrFiles() As Variant)
 
    Dim intLoop         As Long
 
    Dim i               As Integer
 
    Dim objApp          As Object
 
    Dim vFileNameZip
 
 
 
    If Right(strZipFilePath, 1) <> Application.PathSeparator Then
 
        strZipFilePath = strZipFilePath & Application.PathSeparator
 
    End If
 
    vFileNameZip = strZipFilePath & strZipFileName & ".zip"
 
 
 
    If IsArray(arrFiles) = False Then GoTo ExitH
 
 
 
'-------------------Create new empty Zip File-----------------

    If Len(Dir(vFileNameZip)) > 0 Then Kill vFileNameZip
 
    Open vFileNameZip For Output As #1
 
    Print #1, Chr$(80) & Chr$(75) & Chr$(5) & Chr$(6) & String(18, 0)
 
    Close #1
 
'=============================================================

    Set objApp = CreateObject("Shell.Application")
 
    i = 0
    

    For intLoop = LBound(arrFiles) To UBound(arrFiles)
 
        'Copy file to Zip folder/file created above

        i = i + 1
 
        objApp.Namespace(vFileNameZip).CopyHere arrFiles(intLoop)
        
        'Wait until Compressing is complete

        On Error Resume Next
 
        Do Until objApp.Namespace(vFileNameZip).Items.Count = i
 
            Application.Wait (Now + TimeValue("0:00:01"))
 
        Loop
 
        On Error GoTo 0
 
 
    Next intLoop
 
ExitH:
 
    Set objApp = Nothing
 
End Sub

The parameters of the function are set to

Capture.PNG


But when I run the code, it is keep looping over this part

Do Until objApp.Namespace(vFileNameZip).Items.Count = i
 
     Application.Wait (Now + TimeValue("0:00:01"))
 
Loop

Anyone know why?

[WideBoyDixon]

It could be related to how you're passing the array of files to zip. ParamArray expects multiple values separated with a comma so you need to call it like this:

ZipFile "C:\Test", "Test", "[path to file 1]", "[path to file 2]", "[path to file 3]"

Do not try and pass it as an array. If you want to pass an array, change the final parameter in the function:

Sub ZipFile(strZipFilePath As String, strZipFileName As String, arrFiles As Variant)

Then you can call it like this:

ZipFile "C:\Test", "Test", Array("[path to file 1]", "[path to file 2]", "[path to file 3]")

WBD

[mp3909]

Hi WBD,

I only have one file to zip, so I am essentially just passing one file to the function.

I tried what you said in your reply but still no luck

[WideBoyDixon]

Ah. OK. I tried a little test locally on my PC and it worked. I also tried passing a UNC path (as in your example) and that also worked. I'm not sure why it wouldn't work for you.

WBD

[mp3909]

could it be because the file that I want to zip is saved in a shared network drive that I only have read access to

[WideBoyDixon]

Shouldn't be but you could try zipping up other files or changing the permissions on the file to see if that makes a difference.

WBD