检索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

它取自我的文章：

使用VBA压缩和解压缩文件和文件夹Windows资源管理器方式

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

完整代码也在GitHub:VBA上。压缩

其中睡眠功能也可在模块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