Create zip error: Namespace method fails on IShellDispatch

[Siddhant Chothe]

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:

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 attached the file that was experimented with.

 

[Marc L]

Hi !

Many of VBA code works only on 32 bits Office version
and can't on 64 bits Office version,
the reason why Microsoft itself advise to install only 32 bits version …
​

 

[Siddhant Chothe]

Hi !

Many of VBA code works only on 32 bits Office version
and can't on 64 bits Office version,
the reason why Microsoft itself advise to install only 32 bits version …
​

The machine has Office Professional 2010 32 bit.

 

[Chihiro]

Double parenthesis will be issue if variable is declared as string. But since it's kept as variant to avoid this issue, that's not cause of your error.

Not sure if this is issue, but why are oApp and dFolder declared as variant?