检索 ZIP 文件中的文件列表

Question

我将 MS Access 文件发送到一个 zip 文件，以便每晚通过 MS Access 文件备份它们。有些是超过 2GB 的大文件，在我们缓慢的共享驱动器网络上压缩需要 5 到 10 分钟。我希望我的 ACCDB 文件暂停，直到文件完全复制到 zip 文件中，然后再继续下一个文件。它目前几乎立即进入下一个文件，事情很快就搞砸了，特别是因为我在将 MS Access 文件复制到 zip 后杀死了它。

1. 尝试在 zip 中找到文件，然后我将最终构建一个带有计时器的循环，直到 Dir 存在为止。

   'copy files to zip
   Dim shl As New Shell32.Shell
   shl.NameSpace(strZipFilePath).CopyHere (strZip)
   
   Set sh = CreateObject("Shell.Application")
   x = GetFiles(strPath, "*.zip", True)
   'This crashes Access
   For Each i In x
       Set n = sh.NameSpace(i)
       Debug.Print n
       Next i
   End
   

2. 暂停 600 秒...有时可行，有时不可行，这取决于网络流量。

   Do While Dir(strZip) <> 0
           sngStart = ""
           sngStart = Timer
           Do While Timer < sngStart + 600 '10 minutes=600 seconds
               DoEvents
           Loop
   Loop
   

Answer 1

您可以使用类似于我使用 API 调用休眠压缩文件和文件夹时所做的方法：

        With ShellApplication
            Debug.Print Timer, "Zipping started . ";
            .Namespace(CVar(ZipTemp)).CopyHere CVar(Path)
            ' Ignore error while looking up the zipped file before is has been added.
            On Error Resume Next
            ' Wait for the file to created.
            Do Until .Namespace(CVar(ZipTemp)).Items.Count = 1
                ' Wait a little ...
                Sleep 50
                Debug.Print ".";
            Loop
            Debug.Print
            ' Resume normal error handling.
            On Error GoTo 0
            Debug.Print Timer, "Zipping finished."
        End With

摘自我的文章：

Zip and unzip files and folders with VBA the Windows Explorer way

（如果您没有帐户，请浏览链接：阅读全文。）

完整代码也在GitHub上：VBA.Compress

Sleep 功能也在模块FileCompress.bas 中找到

' Suspends the execution of the current thread until the time-out interval elapses.
'
#If VBA7 Then
    Private Declare PtrSafe Sub Sleep Lib "kernel32" ( _
        ByVal dwMilliseconds As Long)
#Else
    Private Declare Sub Sleep Lib "kernel32" ( _
        ByVal dwMilliseconds As Long)
#End If