MS Access VBA -> Получить список файлов внутри ZIP-файла - PullRequest
Новая
       86

MS Access VBA -> Получить список файлов внутри ZIP-файла

1 голос
/ 01 ноября 2019

Я отправляю файлы MS Access в zip-файл, чтобы каждую ночь выполнять их резервное копирование с помощью файла MS Access. Некоторые из них представляют собой большие файлы размером более 2 ГБ, которые занимают от 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

1 Ответ

2 голосов
/ 01 ноября 2019

Вы можете использовать метод, аналогичный тому, который я использую при архивировании файлов и папок с помощью вызова 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.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
...