Ms-Access 表单数据导出到 Word

Question

我真的有些帮助！这是我正在努力解决的访问数据库的 google drive zip 的链接。 https://drive.google.com/file/d/0BwjnhQS2X7_Qamt4clFLc1Ztb2c/view?usp=sharing

所以，我拥有的是一个由几个表和一个表单以及一些子表单组成的访问数据库。数据库信息通过我创建的表单输入到表中。在示例中，表单称为“数据库”。此表单导出到 word 文档，数据库上的字段转到 word doc 上的书签。到目前为止，这很好用。

在附件中有一个包含原始 Word 文档的“模板”文件夹，当代码运行时，它会将完成的表单保存到“生成”文件夹 - 就像一个魅力。它是申请酒牌的很长的表格。

所以你在access中填写表格，它会保存到表格中并将数据导出到word模板文档中。

我遇到的问题是表单的 tab8 上有一个子表单，其中保存了“导演详细信息”。每个申请可以有任意数量的董事。我设法访问了子表单表上的数据，但不知道如何遍历该表中的数据以获取仅适用于该应用程序的所有信息，而不是与其他应用程序相关的数据。主管详细信息表和应用程序详细信息表（这是主表）之间存在关系，我正在使用我创建的应用程序标识符字段和“ACNumber”，该字段对每个应用程序都是唯一的。表单上有一个选择应用程序的组合框，当您选择它时，表单和子表单会显示正确的数据。

问题的另一部分是如何将其输出到 word 中？书签不起作用，因为所有字段都在重复。有没有一种方法可以将所有数据条目输出到带有标签的文本框中的单个书签？

这是它在word文档表单上的样子：

（第一人称）
全名：从数据库中的项目 5.4(a) 生成 物理地址：从数据库中的项目 5.4(b) 生成 邮政编码：从数据库中的项目 5.4(c) 生成 邮政地址：从数据库中的第 5.4(d) 项生成 邮政编码：从数据库中的项目 5.4(e) 生成 身份证号：从数据库中的 5.4(f) 项生成

（如果需要，可以添加更多人）

好的，我希望准确地描述了我的问题。 我已经尝试了各种方法来让这个工作，但它超出了我的范围，请帮助大家！！！ 下面是我正在使用的代码：（子表单的循环不起作用，但该表中的一个条目被导出到当前位置的书签） 我已经尝试了各种方法来让它工作，但它超出了我的范围，请帮助大家！！！

---

`Private Sub ExportToWord_Click()

'Print customer slip for current customer.
  Dim appWord As Word.Application
  Dim doc As Word.Document
  Dim drst As Recordset
  Set drst = CurrentDb.OpenRecordset(Name:="62 Other Interests", Type:=RecordsetTypeEnum.dbOpenDynaset)
  'Avoid error 429, when Word isnt open.
  On Error Resume Next
  Err.Clear
  'Set appWord object variable to running instance of Word.
  Set appWord = GetObject(, "Word.Application")

  If Err.Number <> 0 Then
    'If Word isnt open, create a new instance of Word.
    Set appWord = New Word.Application
  End If
  Set doc = appWord.Documents.Open("C:\forms\templates\Form 3 - Sec 36(1).docx", , True)
  With doc
    .Bookmarks("wAppTradingNames").Range.Text = Nz(Me!AppTradingName, "")
    .Bookmarks("wAppTradingName").Range.Text = Nz(Me!AppTradingName, "")
    .Bookmarks("wCompanyName").Range.Text = Nz(Me!CompanyName, "")
    .Bookmarks("wCompanyNumber").Range.Text = Nz(Me!CompanyNumber, "")
    .Bookmarks("wRAddress1").Range.Text = Nz(Me!RAddress1, "")
    .Bookmarks("wPostalCode").Range.Text = Nz(Me!PostalCode, "")
    .Bookmarks("wRPostalAddress1").Range.Text = Nz(Me!RPostalAddress1, "")
    .Bookmarks("wRPostalCode").Range.Text = Nz(Me!RPostalCode, "")
    .Bookmarks("wDomicilium1").Range.Text = Nz(Me!Domicilium1, "")
    .Bookmarks("wDomiciliumCode").Range.Text = Nz(Me!DomiciliumCode, "")
    .Bookmarks("wDomAfter1").Range.Text = Nz(Me!DomAfter1, "")
    .Bookmarks("wDomAfterCode").Range.Text = Nz(Me!DomAfterCode, "")
    .Bookmarks("wTelOffice").Range.Text = Nz(Me!TelOffice, "")
    .Bookmarks("wTelCell").Range.Text = Nz(Me!TelCell, "")
    .Bookmarks("wTelHome").Range.Text = Nz(Me!TelHome, "")
    .Bookmarks("wFaxNumber").Range.Text = Nz(Me!FaxNumber, "")
    .Bookmarks("wEmail").Range.Text = Nz(Me!Email, "")
    .Bookmarks("wFIP").Range.Text = Nz(Me!FIP, "")
    .Bookmarks("wAppLicCat").Range.Text = Nz(Me!AppLicCat, "")
    .Bookmarks("wLiqourType").Range.Text = Nz(Me!LiqourType, "")
    .Bookmarks("wAppTradingName").Range.Text = Nz(Me!AppTradingName, "")
    .Bookmarks("wAppTradingName").Range.Text = Nz(Me!AppTradingName, "")
    .Bookmarks("wLPAddress").Range.Text = Nz(Me!LPAddress, "")
    .Bookmarks("wErfNumber").Range.Text = Nz(Me!ErfNumber, "")
    .Bookmarks("wLPPostalCode").Range.Text = Nz(Me!LPPostalCode, "")
    .Bookmarks("wLPOwnership").Range.Text = Nz(Me!LPOwnership, "")
    .Bookmarks("wLPOwnersName").Range.Text = Nz(Me!LpOwnersName, "")
    .Bookmarks("wLpOwnerAddress").Range.Text = Nz(Me!LpOwnerAddress, "")
    .Bookmarks("wLpRightOccupation").Range.Text = Nz(Me!LpRightOccupation, "")
    .Bookmarks("wLPOccDuration").Range.Text = Nz(Me!LPOccDuration, "")
    .Bookmarks("wLpPremNotErected").Range.Text = Nz(Me!LpPremNotErected, "")
    .Bookmarks("wLpPremAlterReq").Range.Text = Nz(Me!LpPremAlterReq, "")
    .Bookmarks("wLpPremAllGood").Range.Text = Nz(Me!LpPremAllGood, "")
    .Bookmarks("wLpBuildCommence").Range.Text = Nz(Me!LpBuildCommence, "")
    .Bookmarks("wLpBuildDuration").Range.Text = Nz(Me!LpBuildDuration, "")
    .Bookmarks("wLpTradingHours").Range.Text = Nz(Me!LpTradingHours, "")
    .Bookmarks("wLpRenewal").Range.Text = Nz(Me!LpRenewal, "")
    .Bookmarks("wLpJobsa").Range.Text = Nz(Me!LpJobsa, "")
    .Bookmarks("wLpJobsB").Range.Text = Nz(Me!LpJobsB, "")
    .Bookmarks("wLpJobsC").Range.Text = Nz(Me!LpJobsC, "")
    .Bookmarks("wNNPRegName").Range.Text = Nz(Me!NNPRegName, "")
    .Bookmarks("wNNPRegNumber").Range.Text = Nz(Me!NNPRegNumber, "")
    .Bookmarks("wNNPRegDate").Range.Text = Nz(Me!NNPRegDate, "")
    .Bookmarks("wOtherInterests").Range.Text = Nz(drst!OtherInterests, "")
    .Visible = True
    .Activate
  End With

  Dim rst As Recordset: Set rst = CurrentDb.OpenRecordset(Name:="5 Director Details", Type:=RecordsetTypeEnum.dbOpenDynaset)
  'Do While Not rst.EOF
    With doc
      .Bookmarks("wPersonLabel").Range.Text = Nz(rst!PersonLabel, "")
      .Bookmarks("wFullName").Range.Text = Nz(rst!FullName, "")
      .Bookmarks("wPhAddress").Range.Text = Nz(rst!PhAddress, "")
      .Bookmarks("wPhCode").Range.Text = Nz(rst!PhCode, "")
      .Bookmarks("wPAddress").Range.Text = Nz(rst!PAddress, "")
      .Bookmarks("wPCode").Range.Text = Nz(rst!PCode, "")
      .Bookmarks("wIdNumber").Range.Text = Nz(rst!IdNumber, "")
      .Visible = True
      .Activate
      rst.MoveNext
    End With
  'Loop

  doc.SaveAs2 "C:\forms\generated\" & Me!ACNumber & "_Form 3 - Sec 36(1).docx"
  Set doc = Nothing
  Set appWord = Nothing
  Exit Sub

errHandler:
  MsgBox Err.Number & ": " & Err.Description

End Sub


`

Answer 1

这将为您指明正确的方向。您需要进行一些更改以满足您的需求，例如插入所有书签，更新 SQL 字符串和记录集字段。

不过，您还需要对 Word 文档进行一些更改：

1) 添加一个表格来保存经理数据（循环）。如果需要，隐藏边框。
2) 将文档另存为 Word 模板 (.dotx)

Public Sub ExportToWord()
    On Error GoTo ErrorTrap

    Const TemplatePath As String = "C:\forms\templates\Form 3 - Sec 36(1).dotx"

    'Data
    Dim rs As DAO.Recordset
    Set rs = CurrentDb().OpenRecordset("SELECT * FROM TableName WHERE [Criteria]", dbOpenSnapshot)

    'SaveAs
    Dim name_ As String
        name_ = "C:\forms\generated\" & rs![FieldName] & "_Form 3 - Sec 36(1).docx"

    'Word
    Dim oWord As Word.Application
    Set oWord = New Word.Application
        oWord.Visible = False

    Dim oDoc As Word.Document
    Set oDoc = oWord.Documents.Add(TemplatePath)
    With oDoc
        .Bookmarks("Bookmark_1").Range.Text = rs![FieldName_1]
        .Bookmarks("Bookmark_2").Range.Text = rs![FieldName_2]
        .Bookmarks("Bookmark_3").Range.Text = rs![FieldName_3]
        '...
    End With

        rs.Close
    Set rs = Nothing

    'Loop data
    Set rs = CurrentDb().OpenRecordset("SELECT * FROM TableName WHERE [Criteria]", dbOpenSnapshot)
    With rs
        If Not .EOF Then
            .MoveLast
            .MoveFirst
        End If
    End With

    Dim idx As Integer
    For idx = 1 To rs.RecordCount
        With oDoc.Tables(1)
            .Cell(idx, 1).Range.Text = rs![FieldName_1]    '1st Column
            .Cell(idx, 2).Range.Text = rs![FieldName_2]    '2nd Column
            .Cell(idx, 3).Range.Text = rs![FieldName_1]    '3rd Column
            '...
            'add extra rows if required
            If rs.AbsolutePosition <> rs.RecordCount - 1 Then .Columns(1).Cells.Add
        End With
        rs.MoveNext
    Next idx

    'Save
    With oDoc
        .SaveAs FileName:=name_, FileFormat:=Word.WdSaveFormat.wdFormatXMLDocument
        .Close SaveChanges:=wdDoNotSaveChanges
    End With

Leave:
    On Error Resume Next
        rs.Close
    Set rs = Nothing
        oWord.Quit
    Set oWord = Nothing
    On Error GoTo 0
    Exit Sub

ErrorTrap:
    MsgBox Err.Description, vbCritical, "ExportToWord()"
    Resume Leave
End Sub