Create zip error: Namespace method fails on IShellDispatch

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.