如何使用VBA代码合并数据表中路径可变的多个PDF文件

Let's fix up your VBA code to reliably merge PDFs from your Access table—your current draft has a few logical gaps and missing pieces that we'll address step by step.

Key Issues in Your Current Code #

Before jumping to the corrected code, let's break down what was off in your draft:

• Loop Variable Conflict: You reused i both for the record count and loop counter, which breaks the loop logic entirely.
• Incorrect Array Dimension: Your ReDim strPDFs(0 To i) created an array with one extra element (since i is the record count, indexes should be 0 To i-1 for i total records).
• Missing MergePDFs Function: You called this critical function but didn't define it—we'll implement it using Adobe Acrobat's API (the standard way to merge PDFs in VBA).
• Undefined request_no: This variable wasn't declared or assigned a value; we'll add notes to ensure it's set properly (e.g., from a form field).
• Backwards Record Deletion: You deleted records only if merging failed, which is risky—we'll adjust this to delete paths only after a successful merge.
• Unnecessary Refresh: DB.Recordsets.Refresh after RS.MoveLast is redundant, as MoveLast already updates the record count.

Corrected Full VBA Code #

First, you need to reference the Adobe Acrobat Type Library:

1. Open the VBA editor (Alt+F11)
2. Go to Tools > References
3. Check the box for Adobe Acrobat xx.x Type Library (version number depends on your Acrobat installation)

Then use this polished code:

Option Explicit

Sub Combine_PDFs_Demo()
    Dim recordCount As Integer ' Total number of PDF paths in the table
    Dim loopCounter As Integer ' Counter for iterating through records
    Dim outputPDFPath As String ' Path for the merged final PDF
    Dim mergeSuccess As Boolean
    Dim db As Database
    Dim rs As Recordset
    Dim pdfPaths() As String ' Array to store all PDF paths
    Dim request_no As Variant ' Assign this value (e.g., from a form field)
    
    ' Example: Pull request_no from a form (update this to match your setup)
    ' request_no = Forms!YourFormName!txtRequestNo
    
    On Error GoTo ErrorHandler
    
    Set db = CurrentDb
    ' Open recordset with PDF paths from your table
    Set rs = db.OpenRecordset("SELECT paths FROM scantemp")
    
    ' Handle empty table case
    If rs.EOF And rs.BOF Then
        MsgBox "No PDF paths found in the table.", vbInformation, "No Files to Merge"
        GoTo Cleanup
    End If
    
    ' Get accurate record count
    rs.MoveLast
    recordCount = rs.RecordCount
    rs.MoveFirst
    
    ' Resize array to fit exactly all PDF paths
    ReDim pdfPaths(0 To recordCount - 1)
    
    ' Populate array with paths from the recordset
    pdfPaths(0) = rs!paths
    For loopCounter = 1 To recordCount - 1
        rs.MoveNext
        pdfPaths(loopCounter) = rs!paths
    Next loopCounter
    
    ' Define output PDF path (add backslash to avoid path errors)
    outputPDFPath = CurrentProject.Path & "\request_pic" & request_no & ".pdf"
    
    ' Run the merge function
    mergeSuccess = MergePDFs(pdfPaths, outputPDFPath)
    
    ' Handle merge result
    If mergeSuccess Then
        MsgBox "PDFs merged successfully!", vbInformation, "Merge Complete"
        ' Delete paths ONLY if merge worked (so you can retry if it fails)
        DoCmd.SetWarnings False
        DoCmd.RunSQL "DELETE FROM scantemp"
        DoCmd.SetWarnings True
    Else
        MsgBox "Failed to combine all PDFs", vbCritical, "Merge Failed"
    End If

Cleanup:
    ' Clean up database objects to avoid memory leaks
    rs.Close
    Set rs = Nothing
    Set db = Nothing
    Exit Sub

ErrorHandler:
    MsgBox "Error: " & Err.Description, vbCritical, "Runtime Error"
    Resume Cleanup
End Sub

Function MergePDFs(arrPDFPaths() As String, outputPath As String) As Boolean
    Dim acroApp As Acrobat.CAcroApp
    Dim destPDF As Acrobat.CAcroPDDoc
    Dim sourcePDF As Acrobat.CAcroPDDoc
    Dim i As Integer
    
    MergePDFs = False
    
    On Error GoTo ErrorHandler
    
    ' Initialize Acrobat objects
    Set acroApp = CreateObject("AcroExch.App")
    Set destPDF = CreateObject("AcroExch.PDDoc")
    
    ' Open the first PDF as the base document
    If Not destPDF.Open(arrPDFPaths(0)) Then
        MsgBox "Could not open source PDF: " & arrPDFPaths(0), vbCritical
        GoTo Cleanup
    End If
    
    ' Merge remaining PDFs into the base document
    For i = 1 To UBound(arrPDFPaths)
        Set sourcePDF = CreateObject("AcroExch.PDDoc")
        If sourcePDF.Open(arrPDFPaths(i)) Then
            ' Insert all pages from source into destination
            If Not destPDF.InsertPages(destPDF.GetNumPages - 1, sourcePDF, 0, sourcePDF.GetNumPages, 0) Then
                MsgBox "Failed to merge PDF: " & arrPDFPaths(i), vbCritical
                GoTo Cleanup
            End If
            sourcePDF.Close
        Else
            MsgBox "Could not open source PDF: " & arrPDFPaths(i), vbCritical
            GoTo Cleanup
        End If
        Set sourcePDF = Nothing
    Next i
    
    ' Save the merged PDF
    If Not destPDF.Save(PDSaveFull, outputPath) Then
        MsgBox "Could not save merged PDF to: " & outputPath, vbCritical
        GoTo Cleanup
    End If
    
    MergePDFs = True

Cleanup:
    ' Clean up Acrobat objects
    destPDF.Close
    Set destPDF = Nothing
    acroApp.Exit
    Set acroApp = Nothing
    Exit Function

ErrorHandler:
    MsgBox "Merge Error: " & Err.Description, vbCritical
    Resume Cleanup
End Function

Key Improvements Explained #

• Option Explicit: Forces variable declaration, preventing typos and undefined variable bugs.
• Robust Error Handling: Catches and reports issues like missing PDFs or Acrobat installation problems.
• Proper Array Sizing: Ensures the array matches the exact number of PDF paths.
• Separate Loop Counter: Uses loopCounter instead of reusing the record count variable, avoiding logic conflicts.
• Safe Record Deletion: Only clears the scantemp table after a successful merge, so you don't lose paths if something goes wrong.
• Empty Recordset Check: Handles the case where there are no PDFs to merge gracefully.
• Explicit Object Cleanup: Properly closes database and Acrobat objects to prevent memory leaks.

内容的提问来源于stack exchange，提问作者awab