Ms-Access表单数据导出到Word

我真的有些帮助！这是一个链接到我努力与访问数据库的谷歌驱动器的zip。 https://drive.google.com/file/d/0BwjnhQS2X7_Qamt4clFLc1Ztb2c/view?usp=sharing Ms-Access表单数据导出到Word

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

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

所以你在访问中填写表格，它存储到表格并将数据输出到word模板文件。

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

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

这是怎么看的word文档形式：

全名（第一人称）：从项目5.4生成（一）从数据库物理地址：从项目5.4生成（二）从数据库邮政编码：根据项目5.4（c）从数据库生成邮政地址：根据项目5.4（d）从数据库生成邮政编码：从项目5.4（e）生成数据库身份号码：从项目5.4（f）来自数据库

（更多pe rson的如果需要添加）

好吧，我希望能够准确地描述我的问题。我已经尝试过各种各样的工作，但它超越了我，请帮助家伙！下面是我正在使用的代码：（子窗体的循环不起作用，但该表中的一个条目被导出到当前的书签）我试过各种方法来实现这个功能，但它超越了我，请帮助家伙！

`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 


`

来源

2017-09-06 Realhost

有多种方法去了解这一点，最明显的一个对我来说将是放置一个书签，并在该书签添加表。查看[此MSDN页面]（https://msdn.microsoft.com/zh-cn/library/w1702h4a.aspx?cs-save-lang=1&cs-lang=vb#code-snippet-1）创建表格，和[这一个]（https://msdn.microsoft.com/en-us/library/tkf9d64e.aspx）将值添加到表的单元格。您也可以在您的模板中包含表格，并将循环中的行添加到表格中。如果您遇到问题，请提出一个新的具体问题。你的问题非常广泛。 –

此外，我会使用Word邮件合并功能，而不是从记录集到书签文本一个接一个地处理值。 –

谢谢Eric！这很好地回答了“如何格式化输出数据的形式”，我将使用一个表格。现在我需要围绕如何遍历子窗体表中的数据来选择和输出与特定应用程序相关的数据。这个子表格将保存与许多单独的表格/许可证申请有关的数据，我只需要获取与特定应用程序相关的条目。我不知道如何编码。 – Realhost

这将指向你到正确的方向。您需要进行一些更改才能满足您的需求，例如插入所有书签，更新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

来源

2017-09-06 11:48:25

谢谢Kostas！我尝试过，并且主要工作。仍然有问题，但如果我无法解决问题，我会提出另一个关于该问题的问题。欣赏它 – Realhost

只需创建一个7列1行的简单表格。将其他列添加到脚本并进行测试。 –

我已经尝试了各种方式，但不断收到错误消息 - 请求的收集成员不存在 – Realhost

Ms-Access表单数据导出到Word

回答

相关问题