使用word docs和ms access生成完整的PDF表格。

Question

我试图使用Microsoft Access来填写带有书签文本表格字段的word文档，然后将它们导出为PDF。我很难在Access中生成能够稳定工作的Visual Basic代码。我继续收到关于word文档被锁定无法编辑的错误。不知道该如何继续

到目前为止，我的代码

Public Sub ExportToMGR()
    Dim wApp As Word.Application
    Dim wDoc As Word.Document
    Dim rs As DAO.Recordset

    Set wApp = New Word.Application
    Set wDoc = wApp.Documents.Open("C:\filepath\doc.docx")
    Set rs = CurrentDb.OpenRecordset("Detail Report - Individuals")

    If Not rs.EOF Then rs.MoveFirst

    Do Until rs.EOF
        wDoc.Bookmarks("FullName1").Range.Text = Nz(rs!ClientName, "")
        wDoc.Bookmarks("FullName2").Range.Text = Nz(rs!ClientName, "")
        wDoc.SaveAs2 "C:\filepath\" & "firstTest.docx"
        rs.MoveNext
    Loop


End Sub

Answer 1

欢迎来到SO。

你不应该打开Word文档，相反，你应该创建一个Word模板（.dotx），并通过调用它添加到文档集合中。.Add() 方法。

一旦文档中充满了数据，你需要调用 .ExportAsFixedFormat() 方法来保存为PDF。

请看下面的例子。

Option Explicit

Private Sub RunMailMerge_Click()
    On Error GoTo Trap

    Const TEMPLATE_PATH As String = "YourTemplateFolder\WordTemplate.dotx"

    Dim wApp As Word.Application
    Dim wDoc As Word.Document
    Dim rs As DAO.Recordset
    Dim idx As Long

    Set wApp = New Word.Application
    wApp.Visible = False

    Set rs = CurrentDb.OpenRecordset("Detail Report - Individuals")
    If rs.EOF Then GoTo Leave

    With rs
        .MoveLast
        .MoveFirst
    End With

    For idx = 1 To rs.RecordCount
        Set wDoc = wApp.Documents.Add(TEMPLATE_PATH)
        With wDoc
            .Bookmarks("FullName1").Range.Text = Nz(rs!ClientName, vbNullString)
            .Bookmarks("FullName2").Range.Text = Nz(rs!ClientName, vbNullString)
            .ExportAsFixedFormat "DocumentPathWithExtension.pdf", wdExportFormatPDF, False, wdExportOptimizeForOnScreen
            .Close wdDoNotSaveChanges
        End With
        Set wDoc = Nothing
        rs.MoveNext
    Next

Leave:
    On Error Resume Next
    If Not rs Is Nothing Then rs.Close
    If Not wDoc Is Nothing Then wDoc.Close wdDoNotSaveChanges
    If Not wApp Is Nothing Then wApp.Quit wdDoNotSaveChanges
    On Error GoTo 0
    Exit Sub

Trap:
    MsgBox Err.Description, vbCritical
    Resume Leave
End Sub