Extracting Data From Word 95

Question

What follows is a gross simplification of the exact format but basically, it looks something like:

<page break>

<page break> .... etc. (*lots* of pages follow)

You can imagine the results if we tried to export this to a text file as-is! We're just not going to get the nice comma-delimited file we're looking for. Converting the table to text within the document won't work either because all it does is remove the gridlines and space things out by adding adding tabs (or whatever other character you choose) in between the "columns." Somehow, I need to get this into MS Access 97 database...

Answer

From: Shamil Salakhetdinov <shamil@marta.darts.spb.ru>
To: <accessd@mtgroup.com>
Subject: Extracting Data From Word 95
Date: 24 April 1999 18:26

Doris,

Here is another solution for your "gross simplification of the exact format". Hope it gives you some more help.

HTH,
Shamil

P.S. The code (MS Word 97 VBA):

'---- cut here ---
Private Const mcstrModuleName As String = "CRent"

Private mtbl As Word.Table

Public Sub Init(ByRef rtbl As Word.Table)
  Set mtbl = rtbl
End Sub

Public Sub Terminate()
  Set mtbl = Nothing
End Sub

Public Property Get Rent() As Currency
  Rent = CCur(MyTrim(mtbl.Columns(2).Cells(1).Range.Text))
End Property

Public Property Get Term() As String
  Term = CStr(MyTrim(mtbl.Columns(4).Cells(1).Range.Text))
End Property

Public Property Get City() As String
  City = CStr(MyTrim(mtbl.Columns(2).Cells(2).Range.Text))
End Property

Public Property Get State() As String
  State = CStr(MyTrim(mtbl.Columns(2).Cells(3).Range.Text))
End Property

Public Property Get BeginDate() As Date
  BeginDate = CDate(MyTrim(mtbl.Columns(5).Cells(2).Range.Text))
End Property

Public Property Get ExpireDate() As Date
  ExpireDate = CDate(MyTrim(mtbl.Columns(5).Cells(3).Range.Text))
End Property

Private Function MyTrim(ByVal vstrText As String)
  Dim strTmp As String
  Dim i As Integer
  If Len(vstrText) > 0 Then
    For i = 1 To Len(vstrText)
      If Asc(Mid(vstrText, i, 1)) >= 20 Then
        strTmp = strTmp & Mid(vstrText, i, 1)
      End If
    Next i
    strTmp = Trim(strTmp)
    If Len(strTmp) > 0 Then
      If Left(strTmp, 1) = "$" Then
        strTmp = Right(strTmp, Len(strTmp) - 1)
      End If
      If Right(strTmp, 1) = ":" Then
        strTmp = Left(strTmp, Len(strTmp) - 1)
      End If
    End If
  End If
  MyTrim = Trim(strTmp)
End Function

'--- cut here ---
Private Const mcstrModuleName As String = "CRents"

Dim mdoc As Word.Document
Dim mlngCount As Long
Dim mcolRents As Collection

Public Sub Init(ByRef rdoc As Word.Document)
  Dim objRent As CRent
  Dim tbl As Word.Table
  Set mdoc = rdoc
  mlngCount = mdoc.Tables.Count
  If mlngCount > 0 Then
    Set mcolRents = New Collection
    For Each tbl In mdoc.Tables
      Set objRent = New CRent
      objRent.Init tbl
      mcolRents.Add objRent
    Next
  End If
End Sub

Public Sub Terminate()
  Dim objRent As CRent
  If mlngCount > 0 Then
    For Each objRent In Me.Items
      objRent.Terminate
    Next
  End If
  Set mcolRents = Nothing
  Set mdoc = Nothing
End Sub

Public Property Get Count() As Long
  Count = mlngCount
End Property

Public Property Get Items() As Collection
  Set Items = mcolRents
End Property

'---- cut here ---
Public Sub TestIt()
  Dim doc As Word.Document
  Dim objRents As CRents
  Dim objRent As CRent

  Set doc = ThisDocument
  Set objRents = New CRents
  objRents.Init doc

  If objRents.Count > 0 Then
    For Each objRent In objRents.Items
      With objRent
        Debug.Print _
           .Rent & _
           ",""" & .Term & """" & _
           ",""" & .City & """" & _
           ",""" & .State & """," & _
           .BeginDate & "," _
           ; .ExpireDate
      End With
    Next
  End If
  objRents.Terminate
End Sub