Wie überprüft man, ob die Zip-Datei zugänglich ist?

Question

Ich habe eine Excel-Tabelle mit vielen PC-Namen. Auf jedem PC sollte eine Sicherung in ZIP-Dateien gespeichert sein, die automatisch generiert werden.

Wenn ich meinen Code ausführe, überprüft er die PC-Namen, um zu prüfen, ob sie ein Backup haben.

Der Sicherungsprozess ist nicht perfekt, daher kann ein Problem nach dem Erkennen des Problems manuell behoben werden.

Eines der Probleme, die ich nicht erkennen kann, ist, wenn der Backup-Prozess nicht abgeschlossen wird und die ZIP-Datei beschädigt wird.

Ich möchte eine andere Funktion schreiben, um beschädigte ZIP-Dateien zu erkennen, die nicht geöffnet werden können. Hier

ist der Code:

Sub check_for_all_backups() 

Dim c As Range 
Dim rng As Range 
Dim Backup As String 

For j = 1 To Worksheets.Count 
Set rng = Sheets(j).UsedRange.Cells 

For Each c In rng 
    If ispcname(Left(c, 7)) = True And Right(c, 1) = "$" Then 

    Dim i 
    i = 1 

    Backup = Left(c, 7) 
    c.Interior.ColorIndex = "0" 

    File = Dir(BU_Folder_Dir) 
    Do While File <> "" 

     isbig = True '| 
     Dim FSO 
     Set FSO = CreateObject("Scripting.FileSystemObject") '| 

     myBool = False 
     isnew = False 
     Backup = Right(Backup, 6) 

      If InStr(File, Backup) > 0 Then 

       myBool = True 
       cfile = Dir(BU_Folder_Dir & Left(c, 7) & "*") 

       Do While cfile <> "" 
        ReDim arr(i) 
        arr(i) = FileDateTime(BU_Folder_Dir & cfile) 

        ReDim Size(i) '| 
        Size(i) = BU_Folder_Dir & cfile 

        fsize = FSO.getfile(Size(i)).Size/1024/1024 'MB 
        If fsize <= 2048 Then 'is file smaller than 2 GB ? 
         isbig = False 
        End If '| 


        If Now - arr(i) < 30 Then 
         isnew = True 
        End If 

        i = i + 1 
        cfile = Dir() 
       Loop 

       If isbig = True Then   '| 
        If c.Comment Is Nothing Then 
         c.AddComment ("reduce _mit size." & vbCrLf & ".zip over 2GB & (" & fsize & ")") 
        End If 
       ElseIf isbig = False Then 
        If Not c.Comment Is Nothing Then 
         c.ClearComments 
        End If 
       End If      '| 

       If isnew = False Then 
        c.Interior.ColorIndex = "6" 
       ElseIf isnew = True Then 
        c.Interior.ColorIndex = "35" 
       End If 
       Exit Do 

      End If 
     File = Dir() 
    Loop 


     If Not myBool Then 
      c.Interior.ColorIndex = "22" 
     End If 

    End If 
Next c 

Next j 

Call backup_statistics 

End Sub 

Die Excel-Tabelle mehr Zwecke hat so das „$“ Zeichen nur einen Unterschied zwischen PC Namen und Backup-Namen verwendet wird, in anderen Subs/Funktionen zu machen. PC-Namen werden mit einer anderen Funktion namens ispcname identifiziert. Der Name der Backup-ZIP-Datei enthält immer den PC-Namen.

Das Skript hat nur Lesezugriff auf die Ordner- und ZIP-Dateien.

Es gibt rund ~ 1000 Zip-Dateien zu prüfen. Ihre Größe kann bis zu 2 GB erreichen, also brauche ich eine Methode, die prüfen kann, ob die Dateien ohne zu viel Verarbeitung zugänglich sind.

Answer 1

Und obwohl in den Kommentaren beantwortet, einige Code zu geben, wenn jemand auf diese Frage Seite landet ...

OK, so dass die Referenzen in den Kommentaren entweder die Dateien aus dem zip extrahieren, die Sie nicht wollen (es dauert ewig und warum, wenn Sie nur den Inhalt überprüfen müssen?) Oder sie geben ihre Variable nicht explizit ein und machen den Code für diejenigen, die mit den Bibliotheken nicht vertraut sind, ziemlich mysteriös. Oder sie haben überflüssige Throw-Dialogfelder usw.

Hier ist eine explizit typisierte Funktion, die eine Liste von Dateien aus der zip zurückgibt, dann können Sie Inhalte mit der Exist-Methode des Dictionary überprüfen.

Option Explicit 

Sub TestCheckZipFileContents() 

    Dim dic As Scripting.Dictionary 
    Set dic = CheckZipFileContents("C:\Users\Bob\Downloads\zipped.zip") 
    Debug.Print VBA.Join(dic.Keys, vbNewLine) 
    Stop 
End Sub 

Function CheckZipFileContents(ByVal sZipFile As String) As Scripting.Dictionary 

    '* Tools->References Microsoft Scripting Runtime     C:\Windows\SysWOW64\scrrun.dll 
    '* Tools->References Microsoft Shell Controls and Automation  C:\Windows\SysWOW64\shell32.dll 

    Dim FSO As Scripting.FileSystemObject 
    Set FSO = New Scripting.FileSystemObject 
    If FSO.FileExists(sZipFile) Then 

     Dim oShell As Shell32.Shell 
     Set oShell = New Shell32.Shell 

     Dim oFolder As Shell32.Folder 

     '* next line is the magic line that opens the zip 
     '* if there is corruption it would start failing here 
     Set oFolder = oShell.Namespace(sZipFile) 

     Dim oFolderItems As Shell32.FolderItems 
     Set oFolderItems = oFolder.Items 

     Debug.Print oFolderItems.Count 

     Dim dicContents As Scripting.Dictionary 
     Set dicContents = New Scripting.Dictionary 

     Dim oFolderItemLoop As Shell32.FolderItem 
     For Each oFolderItemLoop In oFolderItems 
      dicContents.Add oFolderItemLoop, 0 
     Next oFolderItemLoop 

     Set oFolderItemLoop = Nothing 
     Set oFolderItems = Nothing 
     Set oFolder = Nothing 
     Set oShell = Nothing 

     Set CheckZipFileContents = dicContents 


    End If 

End Function