Sub s1()
 Dim tdoc As Document
 Dim i, j As Integer
 Dim str1 As String
'база данных, требуется подключить microsoft activex data objects
 Dim cntstr As String
 Dim cnt As ADODB.Connection
 Dim cmd As New ADODB.Command
 Dim rst As New ADODB.Recordset

 'подключение к каталогу
 cntstr = "Provider=Microsoft.Jet.OLEDB.4.0;User ID=Admin;Data Source=c:\work;" & _
  "Mode=Share Deny None;Extended Properties=""dbase 5.0;"";Jet OLEDB:System database="""";" & _
  "Jet OLEDB:Engine Type=16;Jet OLEDB:Database Locking Mode=0;"

 
 Set cnt = New ADODB.Connection
 cnt.Open cntstr
 'открытие созданной таблицы
 rst.Open "tbl7", cnt, adOpenKeyset, adLockOptimistic

 Set tdoc = ThisDocument
 Set par = tdoc.Paragraphs(1)
  
  'сохранение выбранных данных в таблицу
  rst.MoveFirst
  While Not rst.EOF
    If Not IsNull(rst.Fields("family").Value) Then
        str1 = rst.Fields("family").Value
    Else
        str1 = "<null>"
    End If
    rst.MoveNext
  Wend
  
 rst.Close
End Sub