Sub wdFile ()
Dim fName as String ' имя файла, в который вы будете
' выводить отчет
Dim WordDoc As Object ' объектная переменная, которая будет
' ссылаться на документ Word
Dim strA as string,x as Integer,y as Integer,i as Integer
Dim dbs as Database, rsTable as Recordset, Q as string,k as integer
' предполагается, что файл будет помещен в той же папке,
' что и ваше приложение, но это не обязательно:
fName = App.Path & "имя_файла" & ".doc"
' после чего желательно проверить, нет ли по этому
' пути файла с таким именем, и если есть, обработать эту
' ситуацию должным образом во избежание ошибки
set dbs=OpenDatabase("путь к базе данных")
' таблица, по которой будет создан отчет:
q="Select * From " & "имя таблицы"
Set rsTable=dbs.OpenRecordset(q,dbOpenSnapshot)
Set WordDoc = CreateObject("Word.Document")
WordDoc.Application.Visible = True
WordDoc.Application.WindowState = 1 ' окно Word в полный экран.

strA="Текст_заголовка_документа"
WordDoc.Application.Selection.TypeText Text:=strA
WordDoc.Application.Selection.TypeParagraph ' переход на новую
' строку
y=rsTable.Fields.Count
x=1
' вставка таблицы в документ:
WordDoc.Application.ActiveDocument.Tables.Add Range:= _
WordDoc.Application.Selection.Range, NumRows:=x,
NumColumns:=y
' здесь x - это количество строк вставляемой таблицы
' y - количество столбцов, обычно равное количеству
' полей вашей таблицы.
' если шапка таблицы содержит одну строку, то x=1

' имена полей таблицы переносятся в качестве заголовков столбцов
For i = 0 To rsTable.Fields.Count - 1
WordDoc.Application.Selection.Tables(1).Cell(2,i+1).Select
strA = rsTable.Fields(i).Name
WordDoc.Application.Selection.TypeText Text:=strA
Next i

' добавление к таблице необходимого количества строк
' и заполнение их значениями из исходного запроса:
rsTable.MoveFirst
k = 0
Do
k = k + 1
WordDoc.Application.Selection.MoveDown Unit:=5, _
Count:=1
WordDoc.Application.Selection.InsertRows 1
WordDoc.Application.Selection.Moveleft Unit:=1, _
Count:=1
For i = 0 To rsTable.Fields.Count - 1
WordDoc.Application.Selection.Tables(1).
Cell(k, i + 1).Select

strA = rsTable.Fields(i)
WordDoc.Application.Selection.TypeText _
Text:=strA
Next i
rsTable.MoveNext
Loop Until rsTable.EOF

End Sub