MS Access VBA->检索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

在模块FileCompress.bas中也找到Sleep函数

' 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