使用 VBA 合并多个文件夹中的 PDF

Question

我在 VBA 中遇到问题，我试图组合多个文件夹（5 个文件夹路径）中的 PDF，以及当用户选择要保存组合文件的位置时。保存合并的 pdf 后，它将打开该文件。我一直在使用多种来源和方法来尝试使其发挥作用，但无济于事。我收到的错误源于 sourcePDDoc 出现为“Nothing”，因此收到错误消息，表明它无法打开 PDF 文档，并且没有合并 pdf。我正在向社区寻求帮助，我将不胜感激。谢谢。

下面提供了VBA代码：

Private Sub SavePDF_Click()
    Dim FSO As Object, myfile As Variant
    Dim acroApp As Object
    Dim acroPDDoc As Object
    Dim saveFilePath As String
    Dim insertSuccess As Boolean

    On Error Resume Next ' Enable error handling
    PRDSetup False, False, False
    
    Set acroApp = CreateObject("AcroExch.App")
    Set FSO = CreateObject("Scripting.FileSystemObject")

    ' Get the folder paths from the text boxes
    Dim folderPaths(1 To 5) As String
    folderPaths(1) = Me.txtFolder1.Value
    folderPaths(2) = Me.txtFolder2.Value
    folderPaths(3) = Me.txtFolder3.Value
    folderPaths(4) = Me.txtFolder4.Value
    folderPaths(5) = Me.txtFolder5.Value

    ' Specify the folder where the merged PDF file will be saved
    Dim saveFolderPath As String
    saveFolderPath = Me.txtCombinedFolder.Value

    ' If the folder path is empty, prompt the user to select a folder
    If saveFolderPath = "" Then
        ' Call GetSaveFolder function to prompt user to select a folder
        saveFolderPath = GetSaveFolder
        
        ' If no folder was selected, display an error message and exit the subroutine
        If saveFolderPath = "" Then
            MsgBox "Please select a folder to save the merged PDF.", vbExclamation, "Error"
            Exit Sub
        End If
        
        ' Assign the selected folder path to the txtCombinedFolder control
        Me.txtCombinedFolder.Value = saveFolderPath
    End If

    ' Disable screen updating, events, and alerts
    PRDSetup False, False, False

    ' Create an empty PDF document to merge into
    Set acroPDDoc = acroApp.CreatePDFFromScratch()

    ' Loop through each specified folder path
    Dim folderPath As Variant
    For Each folderPath In folderPaths
        If FSO.folderexists(folderPath) Then
            Dim myFolder As Object
            Set myFolder = FSO.getfolder(folderPath)
            For Each myfile In myFolder.Files
                If UCase(Right(myfile.Path, 4)) = ".PDF" Then
                    ' Open the PDF file
                    Dim sourcePDDoc As Object
                    'On Error Resume Next
                    On Error GoTo 0
                    Set sourcePDDoc = acroApp.Open(myfile.Path)
                    On Error GoTo 0

                    ' Check if the document was opened successfully
                    If sourcePDDoc Is Nothing Then
                        MsgBox "Failed to open PDF document: " & myfile.Path
                        ' You may add additional error handling or logging here
                    Else
                        ' Proceed with inserting pages from the PDF document
                        ' Insert pages into the merged PDF
                        insertSuccess = acroPDDoc.InsertPages(acroPDDoc.GetNumPages - 1, sourcePDDoc, 0, sourcePDDoc.GetNumPages, 0)

                        ' Close the source PDF document
                        sourcePDDoc.Close

                        ' Check if the pages were inserted successfully
                        If Not insertSuccess Then
                            MsgBox "Failed to insert pages from: " & myfile.Path
                        Else
                            Debug.Print "Pages inserted from: " & myfile.Path
                        End If
                    End If
                End If
            Next myfile
        End If
    Next folderPath

    ' Save the merged PDF file
    If Not acroPDDoc Is Nothing Then
        saveFilePath = saveFolderPath & "MergedPDF.pdf"
        acroPDDoc.Save 1, saveFilePath
        acroPDDoc.Close
    
        ' Display success message
        MsgBox "PDF files have been merged and saved to:" & vbCrLf & saveFilePath, vbInformation, "Success"
    
        ' Open the merged PDF file
        Shell "explorer.exe """ & saveFilePath & """", vbNormalFocus
    Else
        MsgBox "Error: Merged PDF document is not available.", vbExclamation, "Error"
    End If
    
    ' Clean up Acrobat objects
    acroApp.Exit
    Set acroApp = Nothing
    
    On Error GoTo 0 ' Disable error handling
End Sub

Answer 1

假设

myfile.Path

无效。

Option Explicit

Private Sub findPath()

    Dim FSO As Object
    Dim myfile As Variant
            
    Set FSO = CreateObject("Scripting.FileSystemObject")
    
    ' Get the folder paths from the text boxes
    Dim folderPaths(1 To 5) As String
    
    folderPaths(1) = Me.txtFolder1.Value
    Debug.Print folderPaths(1)
    
    folderPaths(2) = Me.txtFolder2.Value
    Debug.Print folderPaths(2)
    
    folderPaths(3) = Me.txtFolder3.Value
    Debug.Print folderPaths(3)
    
    folderPaths(4) = Me.txtFolder4.Value
    Debug.Print folderPaths(4)
    
    folderPaths(5) = Me.txtFolder5.Value
    Debug.Print folderPaths(5)
   
    ' Loop through each specified folder path
    Dim folderPath As Variant
    Dim myFolder As Object
    
    For Each folderPath In folderPaths
    
        Debug.Print folderPath
        
        If FSO.FolderExists(folderPath) Then
        
            Set myFolder = FSO.GetFolder(folderPath)
            
            For Each myfile In myFolder.Files
            
                Debug.Print "myfile.Path: " & myfile.Path
                
                If UCase(Right(myfile.Path, 4)) = ".PDF" Then
                    Debug.Print
                    Debug.Print ".PDF found"
                    Debug.Print "myfile.Path: " & myfile.Path
                    Debug.Print
                End If
                
            Next myfile
        End If
    Next folderPath

End Sub

最小 OERN：

' ...
On Error Resume Next    ' Limit scope to the least number of lines
Set sourcePDDoc = acroApp.Open(myfile.Path)
On Error GoTo 0

' Check if the document was opened successfully
If sourcePDDoc Is Nothing Then
' ...