Question

我正在尝试从zip文件中提取589个pdf文件到目标文件夹。每天，都会从网站上下载zip文件，并且每天也会创建目标文件夹。因此，我将“ FromFolder”和“ ToFolder”设置为一个变量，该变量将来自文本框。

我有https://www.ozgrid.com/forum/forum/help-forums/excel-general/68041-extract-zip-files-without-winzip中的这段代码，但是我编辑了FromFolder和ToFolder使其成为变量。

尝试时，仅会提取一份PDF，并且excel会挂起。

有人知道此代码有任何解决方法吗？我不确定问题出在哪里。非常感谢！

 Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
    Sub ExtractPDF_Click()
        Call Copy_Files(FromFolder:=tbPDFpath.Value, ToFolder:=tbDestination.Value, FolderItself:=False)
    End Sub


Sub Copy_Files(FromFolder As String, ToFolder As String, _
                    Optional FolderItself As Boolean = False, _
                    Optional ErrorFound As Boolean = False)

Const LoopWait As Long = 1, EndWait As Long = 5 'seconds
Dim FromFolderVar As Variant, ToFolderVar As Variant
Dim ShellApp As Object
Dim ItemCount As Long, AdditionalCount As Long

On Error GoTo EndSub
ErrorFound = False: Err.Clear

FromFolderVar = CVar(FromFolder)
ToFolderVar = CVar(ToFolder)
Set ShellApp = CreateObject("Shell.Application")

With ShellApp

    ItemCount = .Namespace(ToFolderVar).Items.Count

    If FolderItself Then
        AdditionalCount = 1
        .Namespace(ToFolderVar).CopyHere .Namespace(FromFolderVar)
    Else
        AdditionalCount = .Namespace(FromFolderVar).Items.Count
        .Namespace(ToFolderVar).CopyHere .Namespace(FromFolderVar).Items
    End If

    On Error Resume Next 'need to it error skip if it hasn't finished setting up the folder, and so can't 'read' its contents
        Do Until .Namespace(ToFolderVar).Items.Count = ItemCount + AdditionalCount
            Sleep LoopWait * 1000 'Keep script waiting until copying / compressing is done
        Loop
    On Error GoTo EndSub

End With

Sleep EndWait * 1000 'insert a pause at the end to be on the safe side
Set ShellApp = Nothing

Exit Sub
End Sub

提取PDF时Excel VBA挂起

0 个答案: