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

Question

我有一个 Excel table 有很多 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 table 有更多用途，所以“$”符号仅用于区分其他 subs/functions 中的 PC 名称和备份名称。 PC 名称由另一个名为 ispcname 的函数标识。备份 .zip 文件的名称始终包含 PC 名称。

脚本只有文件夹和 zip 文件的读取权限。

大约有 ~1000 个 zip 文件需要检查。它们的大小可以达到 2 GB，所以我需要一些方法来检查文件是否可以访问而无需太多处理。

Answer 1

所以虽然在评论中回答了，但如果有人登陆这个问题页面，请提供一些代码...

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

这是一个显式类型的函数，它 returns zip 中的文件列表，然后您可以使用字典的 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

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

How to check if zip file is accessible?

vba

excel

zip

corruption