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?
Bookmarks