Create zip error: Namespace method fails on IShellDispatch - excel

Question

We have been trying to resolve this issue for almost a week now without an answer.
Issue: While creating zip file, an error is thrown saying "The method Namespace failed on IShellDispatch6."
What we have tried so far?
Our code is based on instructions at https://www.rondebruin.nl/win/s7/win001.htm. It works on our development environments but explicitly fails on few of client's machine.
Our code:
Code (vb):
Option Explicit
Public zipfile As Variant ' Care taken that this must be a variant
Private baseDirectory As Variant ' Care taken that this must be a variant
Private FileName As String ' This needn't be a variant - tried and tested.
Private done As Boolean
#If VBA7 Then
Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwmilliseconds As Long)
#Else
Private Declare Sub Sleep Lib "kernel32" (ByVal dwmilliseconds As Long)
#End If
' Optional folderNumber taken to try create 10 zip files in a loop.
' Read somewhere that shell activities spawn into separate threads.
' A loop can expose any such vulneribility
Public Sub zip(Optional folderNumber As Integer = 0)
Dim oApp
Dim dFolder
Sleep 100
baseDirectory = "C:\Users\Siddhant\AppData\Local\Temp\b w\"
zipfile = "" & baseDirectory & "stestzip" & CStr(folderNumber) & ".zip"
FileName = "" & baseDirectory & "stestzip.txt"
'Set dFolder = CreateObject("WScript.Shell")
Set oApp = CreateObject("Shell.Application")
Debug.Print "Starting zip process at " & CStr(VBA.Timer) & ". First creating zip file."
' Note the round brackets below around zipfile - These evaluate zipfile at run-time.
' These are not for parameter passing but to force evaluation.
NewZip (zipfile)
Debug.Print "Zip created at " & CStr(VBA.Timer)
'On Error GoTo here
' On development machine, following works fine.
' On client machine, call to oApp.Namespace(zipfile) fails
' giving error message described at beginning of this post..
Debug.Print "Critical Error----------------" & CStr(oApp.Namespace(zipfile) Is Nothing)
Dim loopChecker As Integer
loopChecker = 1
' On client machine, code doesn't even reach here.
While oApp.Namespace(zipfile) Is Nothing
' Well this loop simply waits 3 seconds
' in case the spawned thread couldn't create zipfile in time.
Debug.Print "Waiting till zip gets created."
Sleep 100
If loopChecker = 30 Then
Debug.Print "Wated 3 seconds for zip to get created. Can't wait any longer."
GoTo afterloop
End If
loopChecker = loopChecker + 1
Wend
afterloop:
Debug.Print "Now Condition is ---------------" & CStr(oApp.Namespace(zipfile) Is Nothing)
If oApp.Namespace(zipfile) Is Nothing Then
Debug.Print "Couldnot create zip file " & zipfile
Exit Sub
End If
Set dFolder = oApp.Namespace(zipfile)
'MsgBox FileName
Sleep 200
dFolder.CopyHere "" & FileName, 4
'Keep script waiting until Compressing is done
On Error Resume Next
Do Until dFolder.Items.Count = 1
done = False
'Application.Wait (Now + TimeValue("0:00:01"))
Sleep 100 'wait for 1/10 th of second
Loop
done = True
On Error GoTo 0
here:
If Not dFolder Is Nothing Then
Set dFolder = Nothing
End If
If Not oApp Is Nothing Then
Set oApp = Nothing
End If
End Sub
Public Function Success() As Boolean
Success = done
End Function
Public Sub ClearFileSpecs()
FileName = ""
End Sub
Public Sub AddFileSpec(FileLocation As String)
FileName = FileLocation
End Sub
Sub NewZip(sPath)
'Create empty Zip File
If Len(Dir(sPath)) > 0 Then Kill sPath
Debug.Print "Creating zip file"
Open sPath For Output As #1
Debug.Print "Zip file created, writing zip header"
Print #1, Chr$(80) & Chr$(75) & Chr$(5) & Chr$(6) & String(18, 0)
Debug.Print "zip header written, closing file."
Close #1
Debug.Print "Closing zip file."
End Sub
Function Split97(sStr As Variant, sdelim As String) As Variant
Split97 = Evaluate("{""" & _
Application.Substitute(sStr, sdelim, """,""") & """}")
End Function
Sub testZipping()
Dim i As Integer
For i = 1 To 10
zip i
Next i
MsgBox "Done"
End Sub
Sub tryWait()
Dim i As Integer
For i = 1 To 10
Sleep 2000
Next i
End Sub
By the way, we have also tried another solution to call oApp.Namespace((zipfile)) forcing evaluation of zipfile variable. Many forums described another issue where literal strings worked with oApp.Namespace("c:\an\example"). In such forums solution to use 2 round brackets was suggested.
But neither keeping "DIM zipfile As Variant" worked nor "oApp.Namespace((zipfile))" work.
Could it be the case that the shell32.dll is damaged on client's machine? Please help! I would be quite thankful for any help offered!
I've also posted this issue at http://forum.chandoo.org/threads/create-zip-error-namespace-method-fails-on-ishelldispatch.34010/

Answer 1

We were finally able to get this through. When it came down to Namespace() method failing on IShellDispatch instance, OS installation had to be repaired which fixed the issue. Further, we later discovered that relying on Windows Shell based zipping isn't reliable enough as the copyhere() method doesn't return any status of completion. Additionally, it is asynchronous which mandates hacks like putting a loop after copyhere() call. This loop would sleep few milliseconds and compare source and target folders' items. This hack causes a possible conflict in actual copyhere operation and the comparison query. We have finally moved on to implementing ZLib based DLL that can help us with our compression and decompression requirements.