涉及wb.Close/wb.Open的Access关联Excel多章节报表PDF生成问询

Hey there, let's work through this report generation challenge, addressing the inconsistencies and workbook handling headaches you're dealing with. Here's a structured approach to make this process reliable:

1. First: Lock Down Your Access Query Order #

To ensure you're rearranging sheets correctly every time, first pull the Access query results into a temporary Excel sheet. This gives you a clear, consistent order reference.

Dim conn As Object
Dim rs As Object
Dim orderSheet As Worksheet

' Create a temporary sheet to hold query order
Set orderSheet = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
orderSheet.Name = "ChapterOrder"

' Connect to Access and pull query data
Set conn = CreateObject("ADODB.Connection")
conn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=C:\YourPath\MemberOfficeDB.accdb;"
Set rs = conn.Execute("YourTargetQueryName")

' Dump query results to the temp sheet
orderSheet.Range("A1").CopyFromRecordset rs

' Clean up connections
rs.Close: conn.Close
Set rs = Nothing: Set conn = Nothing

2. Dynamically Handle Chapter Workbooks (Inconsistencies Included) #

Since chapter reports vary every run, we'll add error handling and flexible sheet copying to adapt to different scenarios.

Dim targetWb As Workbook
Dim chapterWb As Workbook
Dim chapterName As String
Dim chapterPath As String
Dim i As Long

' Create a new target workbook and add the cover first
Set targetWb = Workbooks.Add
Workbooks.Open("C:\YourPath\Cover.xlsx").Sheets(1).Copy Before:=targetWb.Sheets(1)
Workbooks("Cover.xlsx").Close SaveChanges:=False

' Loop through the query order to build the report
For i = 2 To orderSheet.Cells(Rows.Count, 1).End(xlUp).Row
    chapterName = orderSheet.Cells(i, 1).Value
    chapterPath = "C:\YourPath\Chapters\" & chapterName & ".xls" ' Adjust path to your structure

    ' Handle missing/locked files gracefully
    On Error Resume Next
    Set chapterWb = Workbooks.Open(chapterPath, ReadOnly:=True)
    On Error GoTo 0

    If Not chapterWb Is Nothing Then
        ' Copy only visible sheets (skip hidden ones that might be junk)
        Dim ws As Worksheet
        For Each ws In chapterWb.Sheets
            If ws.Visible = xlSheetVisible Then
                ws.Copy After:=targetWb.Sheets(targetWb.Sheets.Count)
            End If
        Next ws

        ' Clean up the chapter workbook immediately
        chapterWb.Close SaveChanges:=False
        Set chapterWb = Nothing
    Else
        ' Log errors so you can follow up on missing chapters
        orderSheet.Cells(i, 2).Value = "ERROR: File missing or locked"
    End If
Next i

3. Fix wb.Open/wb.Close Headaches #

These are the most common pain points—here's how to avoid locks and memory leaks:

• Always open chapter files as read-only to prevent locking the original
• Explicitly set SaveChanges:=False when closing to avoid accidental edits to source files
• Release workbook objects with Set chapterWb = Nothing after closing
• Add error traps for files that are in use or missing

4. Export to PDF and Clean Up #

Finally, export the assembled workbook to PDF and tidy up:

' Export all sheets to PDF (cover + ordered chapters)
targetWb.ExportAsFixedFormat _
    Type:=xlTypePDF, _
    Filename:="C:\YourPath\FinalReport_" & Format(Now(), "YYYYMMDD") & ".pdf", _
    Quality:=xlQualityStandard, _
    IncludeDocProperties:=True, _
    IgnorePrintAreas:=False

' Close the target workbook without saving (we don't need the Excel version)
targetWb.Close SaveChanges:=False

' Delete the temp order sheet (optional but clean)
Application.DisplayAlerts = False
orderSheet.Delete
Application.DisplayAlerts = True

• If chapters have variable sheet names, add a column to your Access query with expected sheet names to target specific sheets instead of copying all
• Add a log sheet to track successes/failures each run—this makes debugging way easier when reports don't turn out right
• Test with a small set of chapters first to iron out path/naming issues before full runs

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