Public Sub MergetoWordf()
' This method creates a new document in
'  MS Word using Automation
On Error Resume Next
Dim rsCust As New ADODB.Recordset
Dim sSQL As String
Dim WordObj As Word.Application
Dim iTemp As Integer
sSQL = "SELECT * FROM Customers  " _
& "WHERE CustomerNumber = " _
& Forms I Orders![CustomerNumber]
rsCust.Open sSQL,  CurrentProject.Connection
If rsCust.EOF Then
MsgBox "Invalid customer", vbOKOnly
Exit Function

End If
DoCmd.Hourglass True
'Try to get a running instance of Word:
Set WordObj  = GetObject(,   "Word.Application")
If Err.Number <> 0 Then
'An error is thrown if Word is not running,
'so use CreateObject to start up Word:
Set WordObj = CreateObject("Word.Application")
End If
'Make sure the user can see Word: WordObj.Visible = True
'Warning:
'Specify the correct drive and path to the 'file named Thanks.dotx in the line below.
WordObj.Documents.Add _
Template:= "C:\Thanks.dotx",  NewTemplate:=False
With WordObj.Selection
.GoTo what :=wdGoToBookmark,  Name : = "FullName" 
.TypeText rsCust![ContactName]
.GoTo what:=wdGoToBookmark, Name:="CompanyName" 
.TypeText rsCust![CompanyName]
.GoTo what:=wdGoToBookmark,  Name:="Address1" 
.TypeText rsCust![Addressl]
.GoTo what:=wdGoToBookmark, Name:="Address2" 
If IsNull(rsCust![Address2])  Then
.TypeText  " "
Else
.TypeText rsCust![Address2] 
End If
 
.GoTo what:=wdGoToBookmark,  Name:="City"
.TypeText rsCust![City]
.GoTo what:=wdGoToBookmark,  Name:="State"
.TypeText rsCust![State]
.GoTo what:=wdGoToBookmark, Name:="Zipcode"
.TypeText rsCust![Zipcode]
.GoTo what:=wdGoToBookmark, Name:="PhoneNumber"
.TypeText rsCust![PhoneNumber]
.GoTo what:=wdGoToBookmark, Name:="NumOrdered" 
.TypeText FormsiOrders![Quantity]
.GoTo what:=wdGoToBookmark, Name:="Productordered" 
If FormsIOrders![Quantity]  > 1 Then
WordObj.Selection.TypeText Forms!Orders![Item] & "s" 
Else
WordObj.Selection.TypeText Forms!Orders![Item] 
End If
.GoTo what:=wdGoToBookmark, Name:="FName"
iTemp = InStr(rsCust![ContactName],   "  ")
If iTemp > 0 Then
.TypeText Lefts(rsCust![ContactName], iTemp - 1) 
End If
.GoTo what:=wdGoToBookmark, Name:="LetterName" 
.TypeText rsCust![ContactName]
DoEvents
WordObj.Activate 
.MoveUp wdLine,  6 
End With
'Set the Word Object to Nothing to free resources: 
Set WordObj = Nothing 
DoCmd.Hourglass False
End Sub