|
|
|
| Title | Use Access data to make a Word table |
|---|
| Keywords | Access, Word, table, VBA |
|---|
| Categories | |
|---|
|
|
|
This VBA 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
|
|
|
Note that this code requires a reference to the ADO library.
|
| |
-->
|
|
