Function WordPutFrRstByName(wrD As Object, rst As Recordset, Optional sSuf As String, Optional SetNull As Boolean) As Boolean     'wrD As  Word.Document 'Object 
 'wrD As Word.Document , Rst - текущая запись 
Dim wrdR As Object   'Word.Range ' 
Dim sName As String, i   As Long
    If Not (rst.EOF And rst.BOF) Then
        On Error Resume Next
        For i =  0  To rst.Fields.Count -  1 
            sName = rst.Fields(i).Name
            If (SetNull) And IsNull(rst.Fields(i)) Then
                 'пропускаем публикацию Null (оставляем "по умолчанию) 
            Else
                Set wrdR = wrD.Bookmarks(sName & sSuf).Range
                If Not wrdR Is Nothing Then
                    wrdR.Text = rst.Fields(i)  'wrdR 
                    wrD.Bookmarks.Add (sName & sSuf), wrdR  'просто вставка затирает закладки 
                    
                     'wrD.CustomDocumentProperties.Add sName & sSuf, 1, 1, 1, sName & sSuf ' как связь 
                     'Add(Name As String, LinkToContent As Boolean, [Type], [Value], [LinkSource]) 
                     'вставляем св-ва: 
                     'wrD.CustomDocumentProperties.Add sName & sSuf, False, FieldTypeTo_CustPropType(rst.Fields(i).TYPE), rst.Fields(i)   ', sName & sSuf 
                End If
            End If
            Set wrdR = Nothing  'чтобы не вставлять при ошибках в старые 
        Next i
        wrD.Fields.Update  'Source 
        wrD.UndoClear
    End If
    WordPutFrRstByName = True
End Function