Ms-Access表单数据导出到Word

Question

我真的有所帮助！这是我正在努力争取的访问数据库的谷歌驱动器zip的链接。 https://drive.google.com/file/d/0BwjnhQS2X7_Qamt4clFLc1Ztb2c/view?usp=sharing

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

在附件中有一个＆＃34;模板＆＃34;带有原始word文档的文件夹，当代码运行时，它将完成的表单保存到＆＃34;生成的＆＃34;文件夹 - 像魅力一样工作。它是申请酒牌的一种很长的形式。

因此，您在访问时填写表单，它将保存到表中并将数据导出到单词模板文档。

我遇到的问题是表格的tab8上有一个子表单，其中＆＃34;导演详细信息＆＃34;得救了。每个应用程序可以有任意数量的控制器。我已设法访问子表单上的数据，但不知道如何遍历该表中的数据以获取仅适用于该应用程序的所有信息，而不知道与其他数据相关的数据应用。导演详细信息表和应用程序详细信息表（这是主表）之间存在关系，我使用我创建的应用程序标识符字段和＆＃34; ACNumber＆＃34;这是每个应用程序独有的。表单上有一个组合框，用于选择应用程序，表单和子表单在您选择时会显示正确的数据。

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

这就是单词文档形式的样子：

（第一人称）
全名：从数据库中的项目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