下面给出的代码获取所有记录,并将它们合并为1个邮件合并的文档。我尝试修改代码本身,以尝试通过邮件合并每个记录的单个文档。
但是,它仅给出错误,即“对象变量或未设置块变量”。我的怀疑是因为使用SQL语句获取的记录会抓住数据库中的全部现有记录。
是否有可能仅通过邮件合并并将每个记录另存为单独的文档?
示例:
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
不要在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