Import from Word

  • Thread starter Thread starter NotGood@All
  • Start date Start date
N

NotGood@All

I get Word documents that have tables (200), the tables consists of 2 fields;
1 is the item number and the other is the details of that item. I would like
to append both the item number and the text to a table that has fields named
“ItemNumber†and “Descriptionâ€. Can code be written so no matter how many
items are on the agenda they can be appended??
 
Yes, look up the TransferText command in Access Help.

-- Dorian
"Give someone a fish and they eat for a day; teach someone to fish and they
eat for a lifetime".
 
Dorian, Hi & thanks. I looked it up but I get "Page cannot be Displayed" Do
you know what I'm doing wrong??
 
Hi NotGood

TransferText will not help you here. It is only useful for
importing/exporting from fixed width or delimited *text* files.

You need to write some code to:
1. Open your document
2. Iterate through all its tables
3. For each table, iterate through all its rows
4. Extract the data values from each cell in the row
5. Do whatever with the data (write them to a new record in your table)

I'm anticipating your next question will be "how?" ;-) so here is some code
that should get you started:

Function ReadWordTables()
Dim wdApp As Word.Application
Dim wdDoc As Word.Document
Dim wdTbl As Word.Table
Dim wdRow As Word.Row
Dim sCell1 As String, sCell2 As String
On Error GoTo ProcErr
Set wdApp = CreateObject("Word.Application")
Set wdDoc = wdApp.Documents.Open( _
CurrentProject.Path & "\TestReadFromTables.doc", _
ReadOnly:=True)
For Each wdTbl In wdDoc.Tables
For Each wdRow In wdTbl.Rows
sCell1 = wdRow.Cells(1).Range.Text
sCell2 = wdRow.Cells(2).Range.Text
' strip off vbCr/vbTab (end of cell marker)
sCell1 = Left(sCell1, Len(sCell1) - 2)
sCell2 = Left(sCell2, Len(sCell2) - 2)
' do something with values
Debug.Print sCell1, sCell2
' of course, you would write them to your table!
Next
Next
ProcEnd:
wdDoc.Close
wdApp.Quit
Set wdDoc = Nothing
Set wdApp = Nothing
Exit Function
ProcErr:
MsgBox Err.Description, vbExclamation, "Error #" & Err.Number
Resume ProcEnd
End Function
 
Graham, Thank you very much. I will attempt to get this to work and post
again when I fail!!

Graham Mandeno said:
Hi NotGood

TransferText will not help you here. It is only useful for
importing/exporting from fixed width or delimited *text* files.

You need to write some code to:
1. Open your document
2. Iterate through all its tables
3. For each table, iterate through all its rows
4. Extract the data values from each cell in the row
5. Do whatever with the data (write them to a new record in your table)

I'm anticipating your next question will be "how?" ;-) so here is some code
that should get you started:

Function ReadWordTables()
Dim wdApp As Word.Application
Dim wdDoc As Word.Document
Dim wdTbl As Word.Table
Dim wdRow As Word.Row
Dim sCell1 As String, sCell2 As String
On Error GoTo ProcErr
Set wdApp = CreateObject("Word.Application")
Set wdDoc = wdApp.Documents.Open( _
CurrentProject.Path & "\TestReadFromTables.doc", _
ReadOnly:=True)
For Each wdTbl In wdDoc.Tables
For Each wdRow In wdTbl.Rows
sCell1 = wdRow.Cells(1).Range.Text
sCell2 = wdRow.Cells(2).Range.Text
' strip off vbCr/vbTab (end of cell marker)
sCell1 = Left(sCell1, Len(sCell1) - 2)
sCell2 = Left(sCell2, Len(sCell2) - 2)
' do something with values
Debug.Print sCell1, sCell2
' of course, you would write them to your table!
Next
Next
ProcEnd:
wdDoc.Close
wdApp.Quit
Set wdDoc = Nothing
Set wdApp = Nothing
Exit Function
ProcErr:
MsgBox Err.Description, vbExclamation, "Error #" & Err.Number
Resume ProcEnd
End Function

--
Good Luck :-)

Graham Mandeno [Access MVP]
Auckland, New Zealand

NotGood@All said:
I get Word documents that have tables (200), the tables consists of 2
fields;
1 is the item number and the other is the details of that item. I would
like
to append both the item number and the text to a table that has fields
named
"ItemNumber" and "Description". Can code be written so no matter how many
items are on the agenda they can be appended??
Click to expand...
Click to expand...
 
I hacked up Graham's really nice code and got it to work... don't know
why, but I could never get the code he posted to work right... so,
here it is... That said, any idea why I had to resort to referencing
the doc/table/row/cell hierarchy using counters? Just wondering...

Function ReadWordTables(ByVal strFile As String)
Dim wdApp As Word.Application
Dim wdDoc As Word.Document
Dim wdTbl As Word.Table
'Dim wdRow As Word.Row
Dim intRow As Integer
Dim sCell1 As String, sCell2 As String

Dim intTableNo As Integer
Dim intRowCount As Integer
Dim intColumnCount As Integer

'-- to write the contents of the cells you need to a table in Access
Dim rs As DAO.Recordset
Set rs = DBEngine(0)(0).OpenRecordset("WordTableContents",
dbOpenTable, dbAppendOnly)

On Error GoTo ProcErr

Set wdApp = CreateObject("Word.Application")
Set wdDoc = wdApp.Documents.Open(strFile, ReadOnly:=True)

'--- Loop through all the tables in the file.
'---for some reason the For Each syntax wouldn't work for me!

For intTableNo = 1 To wdDoc.Tables.Count
'For Each wdRow In wdTbl.Rows '<=== didn't work for me!

For intRow = 1 To wdDoc.Tables(intTableNo).Rows.Count
'sCell1 = wdTbl.Cells(1).Range.Text
sCell1 = wdDoc.Tables(intTableNo).Cell(intRow, 1).Range.Text
sCell2 = wdDoc.Tables(intTableNo).Cell(intRow, 2).Range.Text

' strip off vbCr/vbTab (end of cell marker)
sCell1 = Left(sCell1, Len(sCell1) - 2)
sCell2 = Left(sCell2, Len(sCell2) - 2)
' do something with values
Debug.Print sCell1, sCell2
' of course, you would write them to your table!
With rs
.AddNew
.Fields("TableNo") = intTableNo
.Fields("Column1") = CInt(sCell1)
.Fields("Column2") = sCell2
.Update
End With
Next intRow

Next intTableNo
rs.Close
Set rs = Nothing

ProcEnd:
wdDoc.Close
wdApp.Quit
Set wdDoc = Nothing
Set wdApp = Nothing

If Not rs Is Nothing Then
rs.Close
Set rs = Nothing
End If

Exit Function

ProcErr:
MsgBox Err.Description, vbExclamation, "Error #" & Err.Number
Resume ProcEnd
End Function
 
Hi Piet

I only wrote that code yesterday and it works for me. However, it's
possible the For Each enumeration doesn't work in older versions of Word.
What version are you using?

The numerical enumeration is valid in all versions, and for that reason is
probably preferable. However, I read somewhere that referencing a table
cell via an expression such as:
wdDoc.Tables(intTableNo).Cell(intRow, 1).
is *very* slow, because every reference is recalculated from the top of the
document.

For that reason I would recommend doing it this way:

For intTableNo = 1 To wdDoc.Tables.Count
Set wdTbl = wdDoc.Tables(intTableNo)
For intRow = 1 To wdTbl.Rows.Count
Set wdRow = wdTbl.Rows(intRow)
sCell1 = wdRow.Cells(1).Range.Text
sCell2 = wdRow.Cells(2).Range.Text
.... etc
 
Hi Piet

I only wrote that code yesterday and it works for me.  However, it's
possible the For Each enumeration doesn't work in older versions of Word.
What version are you using?

The numerical enumeration is valid in all versions, and for that reason is
probably preferable.  However, I read somewhere that referencing a table
cell via an expression such as:
    wdDoc.Tables(intTableNo).Cell(intRow, 1).
is *very* slow, because every reference is recalculated from the top of the
document.

For that reason I would recommend doing it this way:

  For intTableNo = 1 To wdDoc.Tables.Count
    Set wdTbl = wdDoc.Tables(intTableNo)
    For intRow = 1 To wdTbl.Rows.Count
      Set wdRow = wdTbl.Rows(intRow)
      sCell1 = wdRow.Cells(1).Range.Text
      sCell2 = wdRow.Cells(2).Range.Text
... etc

--
Good Luck  :-)

Graham Mandeno [Access MVP]
Auckland, New Zealand


I hacked up Graham's really nice code and got it to work... don't know
why, but I could never get the code he posted to work right...  so,
here it is...  That said, any idea why I had to resort to referencing
the doc/table/row/cell hierarchy using counters?  Just wondering...
Click to expand...
Function ReadWordTables(ByVal strFile As String)
Dim wdApp As Word.Application
Dim wdDoc As Word.Document
Dim wdTbl As Word.Table
'Dim wdRow As Word.Row
Dim intRow As Integer
Dim sCell1 As String, sCell2 As String
Click to expand...
Dim intTableNo As Integer
Dim intRowCount As Integer
Dim intColumnCount As Integer
Click to expand...
'-- to write the contents of the cells you need to a table in Access
Dim rs As DAO.Recordset
Set rs = DBEngine(0)(0).OpenRecordset("WordTableContents",
dbOpenTable, dbAppendOnly)
Click to expand...
On Error GoTo ProcErr
Click to expand...
 Set wdApp = CreateObject("Word.Application")
 Set wdDoc = wdApp.Documents.Open(strFile, ReadOnly:=True)
Click to expand...
'--- Loop through all the tables in the file.
'---for some reason the For Each syntax wouldn't work for me!
Click to expand...
 For intTableNo = 1 To wdDoc.Tables.Count
   'For Each wdRow In wdTbl.Rows   '<=== didn't work for me!
Click to expand...
   For intRow = 1 To wdDoc.Tables(intTableNo).Rows.Count
     'sCell1 = wdTbl.Cells(1).Range.Text
     sCell1 = wdDoc.Tables(intTableNo).Cell(intRow, 1).Range.Text
     sCell2 = wdDoc.Tables(intTableNo).Cell(intRow, 2).Range.Text
Click to expand...
     ' strip off vbCr/vbTab (end of cell marker)
     sCell1 = Left(sCell1, Len(sCell1) - 2)
     sCell2 = Left(sCell2, Len(sCell2) - 2)
     ' do something with values
     Debug.Print sCell1, sCell2
     ' of course, you would write them to your table!
     With rs
       .AddNew
       .Fields("TableNo") = intTableNo
       .Fields("Column1") = CInt(sCell1)
       .Fields("Column2") = sCell2
       .Update
    End With
   Next intRow
Click to expand...
Next intTableNo
rs.Close
Set rs = Nothing
Click to expand...
ProcEnd:
 wdDoc.Close
 wdApp.Quit
 Set wdDoc = Nothing
 Set wdApp = Nothing
Click to expand...
 If Not rs Is Nothing Then
   rs.Close
   Set rs = Nothing
 End If
Click to expand...
 Exit Function
Click to expand...
ProcErr:
 MsgBox Err.Description, vbExclamation, "Error #" & Err.Number
 Resume ProcEnd
End Function
Click to expand...
Click to expand...

prehistoric one... the one that comes with a rock and a stick to make
a hammer... Access 2002. Was an interesting exercise making it work,
though! =)
 
Back
Top