如何检查zip文件是否可访问？

Question

我有一个 Excel 表格，上面有很多 PC 名称。每台 PC 都应在服务器上存储一个自动生成的 .zip 文件的备份。

当我运行我的代码时，它会检查 PC 名称以检查它们是否有备份。

备份过程并不完美，因此在检测到问题后可能需要手动解决问题。

我无法检测到的问题之一是备份过程是否未完成并且 .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 表格有更多用途，因此“$”符号仅用于区分 PC 名称和其他子/功能中的备份名称。 PC 名称由另一个名为ispcname 的函数标识。备份 .zip 文件的名称始终包含 PC 名称。

该脚本仅对文件夹和 zip 文件具有读取权限。

有大约 1000 个 zip 文件需要检查。它们的大小可以达到 2 GB，因此我需要一些方法来检查文件是否可以在不进行过多处理的情况下访问。

Answer 1

因此，尽管在 cmets 中回答了，但如果有人登陆此问题页面，请给出一些代码...

好的，因此 cmets 中的引用要么从 zip 中提取您不想要的文件（这将花费绝对时间，为什么您只需要检查内容？）或者他们没有明确键入他们的变量对于那些不熟悉这些库的人来说，该代码非常神秘。或者，他们有多余的抛出对话框等。

这是一个显式类型的函数，它从 zip 中返回文件列表，然后您可以使用 Dictionary 的 Exist 方法检查内容。

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