vba - 检索 ZIP 文件中的文件列表

问题描述

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

尝试在 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

暂停 600 秒……有时这有效，有时无效，这取决于网络流量。

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

标签： vbams-accesszip

您可以使用类似于我使用 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

摘自我的文章：

以 Windows Explorer 方式使用 VBA 压缩和解压缩文件和文件夹

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

完整代码也在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

vba - 检索 ZIP 文件中的文件列表

问题描述

解决方案

推荐阅读