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

我有一个有很多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文件中提取文件（这将需要绝对年龄，为什么当你只需要检查内容？）或者他们没有明确地键入他们的variables使得代码相当对那些不熟悉图书馆的人来说很神秘。 或者，他们有多余的投掷对话框等

这里是一个明确的types化函数，它从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