Question

我们一直在努力解决这个问题，差不多一个星期没有答案。问题：在创建zip文件时，会抛出一个错误，说明＃34; IShellDispatch6上的方法命名空间失败。＆＃34; 到目前为止我们尝试了什么？我们的代码基于https://www.rondebruin.nl/win/s7/win001.htm的说明。它适用于我们的开发环境，但在客户机的一些机器上明显失败。我们的代码：

    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

顺便说一句，我们还尝试了另一种解决方案来调用oApp.Namespace（（zipfile））强制评估zipfile变量。许多论坛描述了另一个问题，其中文字字符串与oApp.Namespace一起使用（＆＃34; c：\ an \ example＆＃34;）。在这样的论坛中，建议使用2个圆括号的解决方案。

但是没有保留＆＃34; DIM zipfile As Variant＆＃34;工作也不是＆＃34; oApp.Namespace（（zipfile））＆＃34;工作

可能是shell32.dll在客户端机器上损坏了吗？请帮忙！我非常感谢你提供的任何帮助！

我还在http://forum.chandoo.org/threads/create-zip-error-namespace-method-fails-on-ishelldispatch.34010/

发布了此问题

Answer 1

我们终于能够通过这个了解。当归结为在IShellDispatch实例上失败的Namespace（）方法时，必须修复操作系统安装，这解决了问题。此外，我们后来发现依赖基于Windows Shell的压缩是不够可靠的，因为copyhere（）方法不会返回任何完成状态。另外，它是异步的，它要求在copyhere（）调用之后放置一个循环。此循环将睡眠几毫秒，并比较源和目标文件夹＆＃39;项目。该hack导致实际复制操作和比较查询中可能的冲突。我们终于开始实现基于ZLib的DLL，它可以帮助我们满足压缩和解压缩要求。

创建zip错误：IShellDispatch上的命名空间方法失败

1 个答案: