Import from word to access

[0243906]

hey,
I have a few thousand word documents that are sent to our department from another company whenever an incident occurs.. The document contains logos, some text, and a table. I would like to make a database of this table. the main problem is importing it into an access table. The table is in the following format:
a ei1
b ei122
c 12 feb05 1130z
d nil
e nil
f captain
g ref231/05

does anyone have any ideas how to make a table from the information. I would need to use the letters a,b,c, etc as column headings.
thanks.

 

[0243906]

Ok, ive figured out that i can copy and past the information into excel, then use the 'paste special transpose' feature to convert the rows to columns, and then import this table into access.
Is there any easier way of doing this as i have thousands of these tables to import.

 

[Remou]

Hi
Just thinking ... Access can import tables from .htm files:
[tt]DoCmd.TransferText acImportHTML, "", "tblTable", "C:\ADoc.htm", False, ""[/tt]
It is possible to loop through your .doc files and save them as .htm

 

[Remou]

Thinking some more ...

Sub Main()
Dim aryDocArray
Dim strWdDoc As String
Dim strWdSaveAs As String
Dim strAccTable As String
Dim strPath As String

'Get list of .doc files, two files only in this directory
'one table per file
strPath = "C:\testdoc\"
aryDocArray = Split(GetFileList(strPath, "*.doc"), ",")

'Loop through .doc array
For i = 0 To UBound(aryDocArray)
    'Names for everything
    strWdDoc = strPath & aryDocArray(i)
    strWdSaveAs = strPath & Left(aryDocArray(i), Len(aryDocArray(i)) - 4) & ".htm"
    strAccTable = Left(aryDocArray(i), Len(aryDocArray(i)) - 4)
    
    'Word stuff
    Call OpenWordDocs(strWdDoc, strWdSaveAs)
    'Access tables
    DoCmd.TransferText acImportHTML, "", strAccTable, strWdSaveAs, False, ""
Next i
End Sub

Function OpenWordDocs(ByVal strWrdDocName As String, strSaveAs As String)
Dim objWord As Word.Document
'Modified (stolen) from Tek-Tips post
'Open word file
Set objWord = GetObject(strWrdDocName, "Word.Document")
objWord.Application.Visible = True
objWord.Application.DisplayAlerts = wdAlertsNone

'Save as .htm
With objWord
    .Application.ActiveDocument.SaveAs FileName:= _
        strSaveAs, FileFormat:=wdFormatHTML, _
        AddToRecentFiles:=False
    .Application.Quit wdDoNotSaveChanges
End With
End Function

Function GetFileList(strDirPath As String, _
                     Optional strFileSpec As String = "*.*", _
                     Optional strDelim As String = ",", _
                     Optional vFileType = vbNormal) As String

    'Modified from code library?

    Dim strFileList     As String   ' Used to collect the file list.
    Dim strFileNames    As String   ' The full path and criteria to search for.
    Dim strTemp         As String   ' Temporarily holds the matching file name.
    
    ' Make sure that strDirPath ends in a "\" character.
    If Right$(strDirPath, 1) <> "\" Then
        strDirPath = strDirPath & "\"
    End If
    
    ' This will be our file search criteria.
    strFileNames = strDirPath & strFileSpec
    
    ' Create a list of matching files delimited by the
    ' strDelim character.
    strTemp = Dir$(strFileNames, vFileType)
    Do While Len(strTemp) <> 0
        strFileList = strFileList & strTemp & strDelim
        strTemp = Dir$()
    Loop
    
    If strFileList <> "" Then
        strFileList = Left(strFileList, Len(strFileList) - 1)
    End If
    GetFileList = strFileList
    
End Function