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 

, 우리는 또한 ZipFile를 변수 ((ZipFile를)) 강제 평가 oApp.Namespace를 호출하는 다른 솔루션을 시도했다. 많은 포럼에서 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 셸 기반 ziping에 의존하는 것은 copyhere() 메서드가 완료 상태를 반환하지 않기 때문에 충분히 신뢰할 수 없다는 것을 나중에 발견했습니다. 또한, 비동기 적으로 해킹을 명령하는데, 이는 copyhere() 호출 후에 루프를 넣는 것과 같다. 이 루프는 몇 밀리 초 동안 잠자기하고 원본 폴더와 대상 폴더의 항목을 비교합니다. 이 해킹은 실제 copyhere 작업과 비교 쿼리에서 충돌을 일으킬 수 있습니다. 마지막으로 ZLib 기반 DLL을 구현하여 압축 및 압축 해제 요구 사항을 해결할 수있었습니다.