Scott Huish
MrExcel MVP
- Joined
- Mar 17, 2004
- Messages
- 20,335
- Office Version
- 365
- Platform
- Windows
I have seen many pages with content like the following: Zip file(s) with the default Windows zip program (VBA)
But no matter what I do it always gets stuck in the Do Until loop and doesn't write any files into the zip file.
My current version of this is as follows:
I have verified that there are valid file paths/filenames for both elements of the array.
But no matter what I do it always gets stuck in the Do Until loop and doesn't write any files into the zip file.
My current version of this is as follows:
Code:
Sub ZipFile(strZipFilePath, file1 As String, file2 As String)
Dim intloop As Long
Dim I As Integer
Dim objApp As Object
Dim vFileNameZip
Dim arrFiles(0 To 1) As String
vFileNameZip = strZipFilePath
arrFiles(0) = file1
arrFiles(1) = file2
'-------------------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
I have verified that there are valid file paths/filenames for both elements of the array.
Last edited: