Function PrintDoc(query As String, _
                  templatedoc As String, _
                  pathname As String, _
                  suffix As String, _
                  print_immidiate As Boolean, _
                  ParamArray fieldsForName() As Variant) As Boolean

  ' query - запрос, который выдает все поля, которые надо разместить на форме
  ' templatedoc - имя файла с шаблоном документа
  ' pathname - путь к файлу, оканчивающийся \. Сюда же можно добавить префикс
  ' suffix - окончание имени файла. Расширение не нужно
  ' fieldsForName - имена полей через запятую, из которых сделать середину имени файла
  
  ' В шабюлоне должны быть настроены  "закладки"  ( "bookmarks" ), с именами, совпадающими
  ' с именами полей или псевдонимами в передаваемом запросе, суфиксом _XX, чтобы добиться
  ' уникальности имен закладок, если одно поле надо вывести более одного раза.
  ' Формат вывода надо настраивать в запросе.

  PrintDoc = True

  Dim wda As Word.Application
  Dim wdd As Word.Document
  
  On Error GoTo worderror
  
  Dim fieldname As String
  Dim fieldname2 As Variant
  Dim filename As String
  
  Dim b As Bookmark
  
  Dim rs As New ADODB.Recordset
  
  rs.Open query, CurrentProject.Connection
  
  If Not rs.EOF Then
    Set wdd = GetObject(templatedoc)
    Set wda = wdd.Parent
    wda.Visible = True
    
    For Each b In wdd.Bookmarks
      fieldname = Mid(b.name,  1 , InStrRev(b.name,  "_" ) -  1 )
      b.Select
      
      If Not IsNull(rs.Fields(fieldname)) And rs.Fields(fieldname) <>  "" Then
        wda.Selection.TypeText rs.Fields(fieldname)
      Else
        wda.Selection.TypeText "   "
      End If
    Next
  Else
    MsgBox " Запрос ничего не вернул ", vbInformation
    PrintDoc = False
  End If
  
  For Each fieldname2 In fieldsForName
    filename = filename & rs.Fields(fieldname2)
  Next
  
  If print_immidiate Then
    wdd.PrintOut False
  End If
  
  wdd.SaveAs (pathname & filename & suffix & " .doc ")
    
  wdd.Close
  wda.Quit
  
  rs.Close
  
  Set rs = Nothing
  Set wda = Nothing
  Set wdd = Nothing
  Exit Function
  
worderror:
  MsgBox " Ошибка:  " & Err.Description & "  " & Err.Number, vbCritical
  PrintDoc = False
  Set rs = Nothing
  Set wda = Nothing
  Set wdd = Nothing
  Exit Function
End Function