2017-04-13 18 views
1

この問題は、ほぼ1週間は解決されませんでした。 問題:zipファイルを作成中に、「メソッドネームスペースがIShellDispatch6で失敗しました」というエラーがスローされます。 これまでに何を試みましたか? コードはhttps://www.rondebruin.nl/win/s7/win001.htmの指示に基づいています。私たちの開発環境では動作しますが、クライアントのマシンでは明示的に失敗します。 当社コード:ところでzipエラーを作成する:IShellDispatchで名前空間メソッドが失敗する

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 

を、我々はまた、ZIPファイルの変数の評価を強制的に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/

+0

"一部のクライアントのマシン"とテストマシンの違いは何ですか? 32対64ビット?別のOSバージョン? – Luuklag

+0

両方のマシンでオペレーティングシステムが一致しています - Windows 10 64ビットとOffice Professional 2010 32ビット。 – sidnc86

答えて

1

でこの問題を掲載しました。 IShellDispatchインスタンスでNamespace()メソッドが失敗すると、OSのインストールを修復して問題を修正する必要がありました。さらに、Windowsシェルベースの圧縮に依存することは、copyhere()メソッドが完了ステータスを返さないため、信頼性が十分ではないことを後で発見しました。さらに、これは非同期で、copyhere()呼び出しの後にループを置くようなハッキングを要求します。このループは数ミリ秒スリープし、ソースとアイテムのフォルダのアイテムを比較します。このハックは、実際のcopyhere操作と比較クエリで起こり得る競合を引き起こします。最後に、圧縮と復元の要件を満たすZLibベースのDLLの実装に移りました。

関連する問題