是否可以通过邮件合并单个记录,而不是将所有记录合并在一个文档中?

问题描述 投票:1回答:1

下面给出的代码获取所有记录,并将它们合并为1个邮件合并的文档。我尝试修改代码本身,以尝试通过邮件合并每个记录的单个文档。

但是,它仅给出错误,即“对象变量或未设置块变量”。我的怀疑是因为使用SQL语句获取的记录会抓住数据库中的全部现有记录。

是否有可能仅通过邮件合并并将每个记录另存为单独的文档?

示例:

  1. 记录1的记录= Record1.docx
  2. 记录2的记录= Record2.docx
  3. 记录2的记录= Record3.docx
Sub startMergeAL()
   Dim oWord As Object, oWdoc As Object
   Dim wdInputName As String, wdOutputName As String, outFileName As String

   'Temporary variables
   Dim totalRecord As Long, recordNumber As Long

   '------------------------------------------------
   ' Set Template Path
   '------------------------------------------------
   wdInputName = CurrentProject.Path & "\Acceptance form V3.docx"

   '------------------------------------------------
   ' Create unique save filename with minutes
   ' and seconds to prevent overwrite
   '------------------------------------------------
   outFileName = "Acceptance Letter - " & Format(Now(), "yyyymmddmms")

   '------------------------------------------------
   ' Output File Path w/outFileName
   '------------------------------------------------
   wdOutputName = CurrentProject.Path & "\Results\" & outFileName

   Set oWord = CreateObject("Word.Application")
   Set oWdoc = oWord.Documents.Open(wdInputName)

   '------------------------------------------------
   ' Start mail merge
   '------------------------------------------------
   With oWdoc.MailMerge
       .MainDocumentType = 0 'wdFormLetters
       .OpenDataSource _
        Name:=CurrentProject.FullName, _
        AddToRecentFiles:=False, _
        LinkToSource:=True, _
        Connection:= _
        "Provider=Microsoft.ACE.OLEDB.12.0;User ID=Admin;Data Source=CurrentProject.FullName;" _
        , SQLStatement:="SELECT * FROM `Acceptance_Letter`"
            .Destination = 0 'wdSendToNewDocument
            .Execute Pause:=False
    End With

    '------------------------------------------------
    ' Hide Word During Merge
    '------------------------------------------------
            oWord.Visible = False

            totalRecord = DCount("*", "Acceptance_Letter")
            Debug.Print ("totalRecord: " & totalRecord)


           ''Error
            For recordNumber = 1 To totalRecord

               Debug.Print ("Print: " & recordNumber)
               outFileName = "Acceptance Letter - " & recordNumber

               '------------------------------------------------
               ' Save file as Word Document
               '------------------------------------------------
               oWord.ActiveDocument.SaveAs2 wdOutputName & recordNumber & ".docx"

               '------------------------------------------------        
               ' Quit Word to Save Memory
               '------------------------------------------------
               oWord.Quit savechanges:=False

               '------------------------------------------------
               ' Clean up memory
               '------------------------------------------------
               Set oWord = Nothing
               Set oWdoc = Nothing

            Next recordNumber
    End Sub
ms-access access-vba
1个回答
0
投票

不要在SQL语句中使用撇号来分隔表名,请使用[ ]。如果未在分配给SQLStatement属性的语句中使用代码,则没有它们,代码将失败。

退出Word并清理循环内的内存可能是导致错误的原因。但是,我怀疑循环是否可以将每个记录保存到单独的doc文件中。这可能需要代码遍历具有字段的记录集,这些记录集将用作构建单个合并记录的过滤SQL的标准,以保存,合并Word文档,关闭Word,移至下一个记录,重复合并。考虑:

Sub startMergeAL()
Dim oWord As Object, oWdoc As Object, rs As DAO.Recordset
Set oWord = CreateObject("Word.Application")
Set rs = CurrentDb.OpenRecordset("SELECT ID FROM Acceptance_Letter")
' Hide Word During Merge
oWord.Visible = False
Do While Not rs.EOF
    Set oWdoc = oWord.Documents.Open(CurrentProject.Path & "\Acceptance form V3.docx")
    ' Start mail merge
    With oWdoc.MailMerge
        .MainDocumentType = 0 'wdFormLetters
        .OpenDataSource _
            Name:=CurrentProject.FullName, _
            LinkToSource:=True, _
            AddToRecentFiles:=False, _
            SQLStatement:="SELECT * FROM [Acceptance_Letter] WHERE ID = " & rs!ID, _
            Connection:= _
                 "Provider=Microsoft.ACE.OLEDB.12.0;User ID=Admin;" & _
                 "Data Source=CurrentProject.FullName;"
        .Destination = 0 'wdSendToNewDocument
        .Execute Pause:=False
    End With
    ' Save file as new Word Document
    oWord.ActiveDocument.SaveAs2 CurrentProject.Path & "\Results\Acceptance Letter - " & _
                   Format(Now(), "yyyymmddmms") & "_" & rs!ID & ".docx"
    oWord.ActiveDocument.Close False
    oWdoc.Close False
    rs.MoveNext
Loop
' Quit Word
oWord.Quit savechanges:=False
End Sub
© www.soinside.com 2019 - 2024. All rights reserved.