Importing Data from Word Tables into Access

Although you’ll be more likely to want to export Access data into Word documents than the reverse, sometimes you need to import data from Word into Access tables. If the Word data is in tables, this can be done with VBA code that works through the cells of the table(s) and saves the data in the cells to fields in an Access table. frmImportFromWord has a tab control with two pages. The Single Table tab displays data imported from a single Word table (a phone list), and the Multiple Tables tab displays data imported from a Word document containing multiple tables with headings and filling two linked Access tables. If there is data in tblEmployeePhones, it is displayed in the subform on the Single Table tab, as shown in Figure 11.21.

Figure 11.21

Clicking the Import Data from Word Table button clears the old data, and then imports new data from a Word document containing a list of employees and their extensions. This event procedure follows, with explanatory text.

 Private Sub cmdImportDatafromWordTable_Click() On Error GoTo ErrorHandler    Dim rst As DAO.Recordset 

Clear the Access table of old data.

    DoCmd.SetWarnings False    strSQL = "DELETE * FROM tblEmployeePhones"    DoCmd.RunSQL strSQL    Me![subEmployeePhones].SourceObject = "" 

Set a reference to the Word application object, and set variables for document name and path.

    Set gappWord = GetObject(, Word.Application)    If CheckDocsDir = False Then       GoTo ErrorHandlerExit    End If    strDocsPath = GetDocsDir    strDocName = "Employee Phones.doc"    strDocName = strDocsPath & strDocName    Debug.Print "Document name: " & strDocName    Set dbs = CurrentDb 

Create a recordset for the Access table to be filled with data from the Word table.

    Set rst = dbs.OpenRecordset("tblEmployeePhones", dbOpenDynaset)     ‘Set a reference to the Word document.    Set doc = gappWord.Documents.Add(strDocName)    gappWord.Visible = True    doc.Activate    With gappWord.Selection 

Go the first table in the document.

       .GoTo What:=wdGoToTable, Which:=wdGoToFirst, Count:=1, Name:="" 

Set a variable with the total number of table rows.

       lngStartRows = gappWord.Selection.Information(wdMaximumNumberOfRows)       Debug.Print "Total table rows: " & lngStartRows 

Move to and select the first cell in the table.

       .MoveDown Unit:=wdLine, Count:=1       .MoveRight Unit:=wdCell       .MoveLeft Unit:=wdCell    End With    lngRows = 0 

Iterate through the table, until reaching the last row, and write information from the Word table cells to the Access table, using the recordset.

    Do While lngRows < lngStartRows       ‘Write info to Access table       With rst          .AddNew          lngRows = gappWord.Selection.Information(wdStartOfRangeRowNumber)          Debug.Print "Current row: " & lngRows          Debug.Print "Employee name: " & gappWord.Selection.Text          ![EmployeeName] = gappWord.Selection.Text          gappWord.Selection.MoveRight Unit:=wdCell          ![Extension] = gappWord.Selection.Text          gappWord.Selection.MoveRight Unit:=wdCell          .Update       End With    Loop        Me![subEmployeePhones].SourceObject = "Table.tblEmployeePhones" ErrorHandlerExit:    rst.Close    Exit Sub ErrorHandler:    If Err = 429 Then       ‘Word is not running; open Word with CreateObject.       Set gappWord = CreateObject("Word.Application")       Resume Next    Else       MsgBox "Error No: " & Err.Number & "; Description: " & Err.Description       Resume ErrorHandlerExit    End If End Sub 

The other tab on frmExportToWord displays Logon information, if tblLogons and the linked table tblLogonValues have data. Clicking the Import Data from Word Tables button runs a Click event procedure that sets up two recordsets, based on the two Access tables, and fills them from data in the Word document; this procedure follows with explanatory text.

 Private Sub cmdImportDatafromWordTables_Click() On Error GoTo ErrorHandler    Dim strSiteName As String    Dim strIDName As String    Dim strIDValue As String    Dim rstOne As DAO.Recordset    Dim rstMany As DAO.Recordset    Dim lngID As Long    Dim strSQL As String 

Clear the Access tables of old data.

    DoCmd.SetWarnings False    strSQL = "DELETE * FROM tblLogonValues"    DoCmd.RunSQL strSQL    strSQL = "DELETE * FROM tblLogons"    DoCmd.RunSQL strSQL 

Remove the subform’s source object.

    Me![subLogons].SourceObject = "" 

Set a reference to the Word application object and folder reference variables.

    Set gappWord = GetObject(, Word.Application)    If CheckDocsDir = False Then       GoTo ErrorHandlerExit    End If    strDocsPath = GetDocsDir    strDocName = "Logons and Passwords.doc"    strDocName = strDocsPath & strDocName    Debug.Print "Document name: " & strDocName    Set dbs = CurrentDb 

Create recordsets for the two linked Access tables to be filled from the Word tables.

    Set rstOne = dbs.OpenRecordset("tblLogons", dbOpenDynaset)    Set rstMany = dbs.OpenRecordset("tblLogonValues", dbOpenDynaset) 

Set a reference to the Word documents.

    Set doc = gappWord.Documents.Add(strDocName)    gappWord.Visible = True    doc.Activate    gappWord.Selection.HomeKey Unit:=wdStory NextItem: 

Search for the next Heading 3 style, and pick up the site name from the text formatted with this style.

    gappWord.Selection.Find.ClearFormatting    gappWord.Selection.Find.Style = ActiveDocument.Styles("Heading 3")    With gappWord.Selection.Find       .Text = ""       .Replacement.Text = ""       .Forward = True       .Wrap = wdFindStop       .Format = True    End With    gappWord.Selection.Find.Execute        If gappWord.Selection.Find.Found = False Then       GoTo ErrorHandlerExit    End If 

Save the site name to the Access table.

    gappWord.Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend    strSiteName = gappWord.Selection    Debug.Print "Site name: " & strSiteName    rstOne.AddNew    rstOne!SiteName = strSiteName    lngID = rstOne!id    Debug.Print "ID: " & lngID    rstOne.Update 

Go to next table in the Word document.

    gappWord.Selection.MoveRight Unit:=wdCharacter, Count:=1    gappWord.Selection.GoTo What:=wdGoToTable, Which:=wdGoToNext,        Count:=1, Name:=""    lngStartRows = gappWord.Selection.Information(wdMaximumNumberOfRows) 

Select the current cell.

    gappWord.Selection.MoveRight Unit:=wdCell    gappWord.Selection.MoveLeft Unit:=wdCell AddValues:    If gappWord.Selection.Type = wdSelectionIP Then GoTo NextItem    gappWord.Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend 

Save the ID name and value to variables.

    strIDName = gappWord.Selection    Debug.Print "ID name: " & strIDName    gappWord.Selection.MoveRight Unit:=wdCell    strIDValue = gappWord.Selection    Debug.Print "ID value: " & strIDValue 

Write the ID name and value to the “many” table.

    With rstMany       Debug.Print "Processing ID " & lngID       .AddNew       ![id] = lngID       ![ItemName] = strIDName       ![ItemValue] = strIDValue       .Update    End With 

Check whether the selection is still in the table, and go to the next heading if it is not.

    gappWord.Selection.MoveRight Unit:=wdCell    lngRows = gappWord.Selection.Information(wdMaximumNumberOfRows)    Debug.Print "Start rows: " & lngStartRows & vbCrLf & "Rows: " & lngRows    If lngRows = lngStartRows Then       If gappWord.Selection.Information(wdWithInTable) = True Then          GoTo AddValues       Else          GoTo NextItem       End If    End If 

Assign tblLogons as the source object of the datasheet subform.

    Me![subLogons].SourceObject = "Table.tblLogons"     ErrorHandlerExit:    rstOne.Close    rstMany.Close    Exit Sub ErrorHandler:    If Err = 429 Then       ‘Word is not running; open Word with CreateObject.       Set gappWord = CreateObject("Word.Application")       Resume Next    Else       MsgBox "Error No: " & Err.Number & "; Description: " & Err.Description       Resume ErrorHandlerExit    End If End Sub 

Figure 11.22 shows the Multiple Tables tab, with data from tblLogons and the linked tblLogonValues tables displayed in a subform.

You can assign a table as the source object of a subform control, which lets you use the subdatasheet feature of linked tables on a form.

Figure 11.22

The Open Report button on both tabs opens an Access report based on the tables filled with imported data; the Employee Phones report is shown in Figure 11.23.

Figure 11.23