Как проверить, доступен ли zip-файл?

Question

У меня есть таблица Excel с большим количеством имен ПК. Каждый ПК должен иметь резервную копию, хранящуюся на сервере в ZIP-файлах, которые автоматически генерируются.

Когда я запускаю свой код, он проверяет имена ПК, чтобы проверить, есть ли у них резервная копия.

Процесс резервного копирования не идеален, поэтому проблема может быть решена вручную после обнаружения проблемы.

Одна из проблем, которые я не могу обнаружить, заключается в том, что процесс резервного копирования не завершается, а .zip-файл поврежден.

Я хочу написать еще одну функцию для обнаружения поврежденных ZIP-файлов, которые невозможно открыть.

Вот код:

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 

таблица Excel имеет несколько целей, поэтому знак «$» используется только, чтобы сделать разницу между именами компьютеров и резервным копированием именами в других Subs/функциях. Имена компьютеров идентифицируются с помощью другой функции, которая называется ispcname. Имя резервного файла .zip всегда содержит имя ПК.

Сценарий имеет доступ только для чтения к папке и zip-файлам.

Проверяются около ~ 1000 почтовых файлов. Их размер может достигать 2 ГБ, поэтому мне нужен какой-то метод, который может проверить, доступны ли файлы без слишком большой обработки.

Answer 1

Так что, хотя ответы в комментариях, давая некоторый код, если кто-то заходит на этот вопрос странице ...

ОК, так что ссылки в комментариях либо извлечь файлы из архива, который вы не хотите (это займет совсем много времени и почему, когда вам нужно только проверить содержимое?) Или они явно не вводят свою переменную, что делает код совершенно загадочным для тех, кто не знаком с библиотеками. Или, у них есть избыточные диалоговые окна бросков и т. Д.

Вот явная типизированная функция, которая возвращает список файлов из zip, после чего вы можете проверить содержимое с помощью метода Exist Dictionary.

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