Question

我有一个包含许多PC名称的Excel表格。每台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

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

好的，所以评论中的引用要么从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

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

1 个答案: