CodeItBetter Programming Another VB Programming Blog

'Database - How to Use Access data to make a Word table
'This code uses data in an Access database to make a table in a Word document.
'It creates an ADO Connection and opens the database. It uses the Connection's
'Execute method to fetch the records of interest and loops through the
'Recordset 's Fields to add their names to a text string separated by tabs. Next
'the code calls the Recordset's GetString method to grab all of the data at
'once, separating fields with tabs and records with vbCrLf. At this point, the
'code has the data so it closes the Recordset and Connection.
'
'The program then makes a Range pointing to the end of the Word document, adds
'the text it has generated, and calls the Range's ConvertToTable method to make
'the table.

Sub ListCustomers()
    Dim db_name As String
    Dim conn As ADODB.Connection
    Dim rs As ADODB.Recordset
    Dim new_field As ADODB.Field
    Dim txt As String
    Dim new_range As Range
 
    ' Compose the database name.
    db_name = Me.Path & "\Customers.mdb"
 
    ' Connect to the database.
    Set conn = New ADODB.Connection
    conn.Mode = adModeRead
    conn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & "Data Source=" & db_name
    conn.Open
 
    ' Select all of the records in the Customers table.
    Set rs = conn.Execute("SELECT DISTINCT ContactName, Street, City, State, " & "Zip, Phone " & _
        "FROM CustomerAddresses ORDER BY ContactName")
 
    ' Add a row containing the field names.
    For Each new_field In rs.Fields
        txt = txt & vbTab & new_field.Name
    Next new_field
    txt = Mid$(txt, 2) & vbCrLf     ' Remove leading tab.

    ' Get the Recordset's data as a single string
    ' with vbTab between fields and vbCrLf between rows.
    txt = txt & rs.GetString(ColumnDelimeter:=vbTab, RowDelimeter:=vbCrLf, NullExpr:="<null>")
 
    ' Close the Recordset and Connection.
    rs.Close
    conn.Close
 
    ' Make a Range at the end of the Word document.
    Set new_range = ActiveDocument.Range
    new_range.Collapse wdCollapseEnd
 
    ' Insert the text and convert it to a table.
    new_range.InsertAfter txt
    new_range.ConvertToTable vbTab
 
    ' Autofit to the contents.
    new_range.Tables(1).AutoFitBehavior wdAutoFitContent
 
    ' Add a blank line.
    Set new_range = ActiveDocument.Range
    new_range.Collapse wdCollapseEnd
    new_range.InsertParagraph
    new_range.Collapse wdCollapseEnd
    new_range.InsertParagraph
End Sub