使用VBA为应用程序打开Word模板文档的多个副本

Question

我正在开发一个数据库应用程序，用户可以在其中打开Word模板文档并将其与数据库记录合并。 我已经成功编写了针对一条记录执行此操作的代码，在该记录中，我打开了模板文件，并用DB数据替换了模板文档中的项目。 我尝试多次打开模板文档（每个DB记录一次），但这会打开一个Word对话框，提示用户以只读方式打开第二个及后续文档（不是很优雅），并且我得到一个Word Normal.dotm关闭每个文档时出错。 因此，如何使用一个模板文档同时创建多个word文档。 我看到的两个选择是：1）在创建其他文档之前以新名称保存一个文档，或者2）拥有一个包含多个页面的文档（每个数据库记录一个），但是要做到这一点，我必须复制并粘贴模板文档每条记录的内容一次，但是我不知道该怎么做。 请记住，我在数据库编程方面有丰富的经验，并且只对VB具有基本的应用程序知识，因此您越明确，它就越有用。

提前致谢。

Answer 1

此功能将基于指定的模板为每个记录创建一个新文档。 我在Word模板中使用预设书签来添加数据库中的数据。 该子程序将在数据库中运行。

Public Sub CreateDocs()

    Dim oWord As Word.Application
    Set oWord = New Word.Application
    Dim oDocument As Word.Document
    Dim oDatabase As DAO.Database
    Set oDatabase = CurrentDb

    ' where to save our files
    Dim strDocPath As String
    strDocPath = CurrentProject.Path & "\"

    ' preset bookmark in template
    Dim oBookMark As Word.Bookmark

    ' query with records
    Dim oRecordset As DAO.Recordset
    Set oRecordset = oDatabase.OpenRecordset("qrySomeQuery")

    ' template file
    Dim strTemplateName As String
    strTemplateName = "C:\users\you\Documents\Doc1.dotx"

    ' hide Word
    oWord.WindowState = wdWindowStateMinimize
    oWord.Visible = False

    While Not oRecordset.EOF
        ' create new document from template
        Set oDocument = oWord.Documents.Add(strTemplatePath, False, , False)

        ' get reference to bookmark in template
        Set oBookMark = oDocument.Bookmarks("bkmkSomePlace")

        ' add our data
        oBookMark.Range.Text = oRecordset.Fields(0).Value & vbTab & oRecordset.Fields(1).Value

        ' Save and close
        ' Saving using one of the query fields that is unique
        oDocument.SaveAs strDocPath & "generatedFile" & oRecordset.Fields(0).Value, wdFormatDocumentDefault
        oDocument.Close

        ' next record
        oRecordset.MoveNext
    Wend

    oWord.Close
    Set oWord = Nothing
    If Not oRecordset Is Nothing Then oRecordset.Close
    Set oRecordset = Nothing
    oDatabase.Close
    Set oDatabase = Nothing
    Set oDocument = Nothing
End Sub