' Поменяй "E:\My Database\dbCustomers.mdb" на реальный путь
' к твоей базе данных.

Private Const strCnnString As String = "Provider=Microsoft.Jet.OLEDB.4.0;" _
  & "Data Source=E:\My Database\dbCustomers.mdb;" _
  & "Persist Security Info=False"

' Подключи библиотеку
' Microsoft ActiveX Data Objects 2.x Library

Public Sub basGetDataFromDatabase()
    Dim cnn As ADODB.Connection
    Dim rstCustomers As ADODB.Recordset
    Dim fld As ADODB.Field
    Dim tblCustomers As Word.Table
    Dim lngRow As Integer
    Dim lngColumn As Integer
    Dim bln As Boolean
        
    Set cnn = New ADODB.Connection
    Set rstCustomers = New ADODB.Recordset
    
    cnn.Open strCnnString
    
    ' tblCustomers - таблица, откуда извлекаем данные.
    rstCustomers.Open "tblCustomers", cnn, _
      adOpenStatic
    
    ' Создаем табличку в Wordе.
    Set tblCustomers = ActiveDocument.Tables.Add( _
      Range:=Selection.Range, _
      NumRows:=rstCustomers.RecordCount +  1 , _
      NumColumns:=rstCustomers.Fields.Count, _
      DefaultTableBehavior:=wdWord9TableBehavior, _
      AutoFitBehavior:=wdAutoFitFixed)
    
    lngRow =  1 
    lngColumn =  1 
    
    ' Заполянем первую строку таблицы названиями полей.
    For Each fld In rstCustomers.Fields
        tblCustomers.Cell(lngRow, lngColumn).Range.Text = fld.Name
        lngColumn = lngColumn +  1 
    Next
    
    lngRow =  2 
    
    ' Заполняем таблицу данными.
    Do Until rstCustomers.EOF
        lngColumn =  1 
        For Each fld In rstCustomers.Fields
            tblCustomers.Cell(lngRow, lngColumn).Range.Text = _
              rstCustomers.Fields(fld.Name)
            lngColumn = lngColumn +  1 
        Next fld
        rstCustomers.MoveNext
        lngRow = lngRow +  1 
    Loop
    
    rstCustomers.Close
    cnn.Close
    
    Set cnn = Nothing
    Set rstCustomers = Nothing
End Sub