Может помошь, если разберешься...

Private Sub Number_DblClick(Cancel As Integer)
Dim WordApp As Word.Application
Dim Document As Word.Document, Range As Word.Range Set FS = CreateObject("Scripting.FileSystemObject")
' открыть документ
Set WordApp = CreateObject("Word.Application")
If FS.FileExists(Setting("Акты выполненых работ", "tFolders") & "\" & "АКТ ВЫПОЛНЕННЫХ РАБОТ_" & Me.Number & "_" & Me.Date & ".doc") Then
WordApp.Application.Documents.Open Setting("Акты выполненых работ", "tFolders") & "\" & "АКТ ВЫПОЛНЕННЫХ РАБОТ_" & Me.Number & "_" & Me.Date & ".doc"
WordApp.Application.Visible = True
Set FS = Nothing
Set Range = Nothing: Set Document = Nothing: Set WordApp = Nothing: Set RS = Nothing
Exit Sub
End If
WordApp.Application.Documents.Add "АКТ ВЫПОЛНЕННЫХ РАБОТ", , , True
WordApp.Application.Visible = True
Set Document = WordApp.Application.ActiveDocument
Set Range = Document.Range

Set RS = CurrentDb.OpenRecordset("SELECT * FROM qJobsActs WHERE Number=""" & Me.Number & """")
' заполнить поля документа
Range.Find.Execute FindText:="%DocNumber", ReplaceWith:=RS.Fields("Number"), Replace:=wdReplaceAll
Range.Find.Execute FindText:="%Vendor", ReplaceWith:=RS.Fields("Vendor"), Replace:=wdReplaceAll
Range.Find.Execute FindText:="%VDirector", ReplaceWith:="генерального директора " & RS.Fields("DSurname") & " " & Left(RS.Fields("DName"), 1) & ". " & Left(RS.Fields("DPatronymicName"), 1) & ".", Replace:=wdReplaceAll
Range.Find.Execute FindText:="%Customer", ReplaceWith:=RS.Fields("Customer"), Replace:=wdReplaceAll

Document.SaveAs Setting("Акты выполненых работ", "tFolders") & "\" & _
"АКТ ВЫПОЛНЕННЫХ РАБОТ_" & Me.Number & "_" & Me.Date & ".doc", wdFormatDocument, , , False
RS.Close
Set Range = Nothing: Set Document = Nothing: Set WordApp = Nothing: Set RS = Nothing

End Sub

2 mers : Можно, помогу, чем смогу.