使用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