創建zip錯誤：命名空間方法在IShellDispatch上失敗

Question

我們一直試圖解決這個問題近一個星期，現在沒有答案。 問題：在創建zip文件時，會拋出一個錯誤提示「方法命名空間在IShellDispatch6上失敗。」 到目前爲止我們試過的是什麼？ 我們的代碼基於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（（zip文件））強制壓縮文件變量的評價。許多論壇描述了字符串與oApp.Namespace（「c：\ an \ example」）一起工作的另一個問題。在這樣的論壇中，建議使用2個圓括號的解決方案。

但是既不保留「DIM zipfile As Variant」也沒有「oApp.Namespace（（zipfile））」工作。

難道是客戶端機器上的shell32.dll損壞的情況嗎？請幫忙！我會非常感謝所提供的任何幫助！

我也張貼了這個問題，在http://forum.chandoo.org/threads/create-zip-error-namespace-method-fails-on-ishelldispatch.34010/

Answer 1

我們終於能夠通過得到這個。當它涉及到IShellDispatch實例上的Namespace（）方法失敗時，必須修復OS安裝以解決問題。此外，我們後來發現，依靠基於Windows Shell的壓縮不夠可靠，因爲copyhere（）方法不會返回任何完成狀態。此外，它是異步的，它要求黑客在copyhere（）調用後放置一個循環。這個循環會睡幾毫秒並比較源文件夾和目標文件夾的項目。這種破解在實際的copyhere操作和比較查詢中會導致可能的衝突。我們終於開始實施基於ZLib的DLL，它可以幫助我們解決壓縮和解壓縮的需求。