کد:
Function main(filter As String)
Dim wordDoc As New Word.Application
Set wordDoc = CreateObject("Word.Application")
Dim templatePath As String, sourceQuery As String
Dim i As Integer
Dim x As Integer
templatePath = "C:\[filepath]" 'your template here
sourceQuery = "[queryname]" 'name of the query in your database
wordDoc.Visible = True 'set connection as visible
wordDoc.Documents.Open templatePath 'open template
wordDoc.ActiveDocument.MailMerge.OpenDataSource Name:= _
"[path to your database]" _
, ConfirmConversions:=False, ReadOnly:=False, LinkToSource:=False, _
AddToRecentFiles:=False, PasswordDocument:="", PasswordTemplate:="", _
WritePasswordDocument:="", WritePasswordTemplate:="", Revert:=False, _
Connection:= _
"Provider=Microsoft.Jet.OLEDB.4.0;Password="""";User ID=Admin;Data Source=C:\yourdatabase.mdb;Mode=Read;Extended Properties="""";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDB
atabase P" _
, SQLStatement:="SELECT * FROM `" & sourceQuery & "`", SQLStatement1:="" 'link to data source
wordDoc.ActiveDocument.MailMerge.SuppressBlankLines = True
x = wordDoc.ActiveDocument.MailMerge.DataSource.RecordCount
If x > 0 Then
For i = 1 To x 'merge+print each record individually
wordDoc.ActiveDocument.MailMerge.DataSource.FirstRecord = i
wordDoc.ActiveDocument.MailMerge.DataSource.LastRecord = i
wordDoc.ActiveDocument.MailMerge.Execute Pause:=False
wordDoc.PrintOut Background:=True
wordDoc.ActiveDocument.Close Savechanges:=False
Next i
wordDoc.Documents.Close Savechanges:=False
wordDoc.Application.Quit 'exit Word
Set wordDoc = Nothing
End If
End Function