title image


Smiley Geht natürlich schon...


Public Function ReadWordTables(Optional DocFileName As String = "I:\Samples\WordTables.doc")

Dim WordObj As Word.Application, WordTbl As Word.Table, WordDoc As Word.Document, _

Col As Long, Row As Long, Res As String, Tmp As String, I As Long, TblName As String, SQL As String, _

DB As DAO.Database, RS As DAO.Recordset, TN As Long



On Error Resume Next

Set WordObj = GetObject(, "Word.Application")

If Err.Number 0 Then Set WordObj = CreateObject("Word.Application")

On Error GoTo 0

Set WordDoc = WordObj.Documents.Open(FileName:=DocFileName, ReadOnly:=True)

'WordObj.Visible = True

'WordObj.Activate

TN = 0

For Each WordTbl In WordDoc.Tables

TN = TN + 1

SQL = ""

For Col = 1 To WordTbl.Columns.Count

WordTbl.Cell(1, Col).Select

Tmp = WordObj.Selection.Text

For I = Len(Tmp) To 1 Step -1

If Asc(Mid(Tmp, I, 1)) >= 32 Then

Tmp = left(Tmp, I)

Exit For

End If

Next I

SQL = SQL & ",[" & Tmp & "] Text(255)"

Next Col

TblName = "Word-Tabelle #" & TN

On Error Resume Next

DB.Execute "DROP TABLE [" & TblName & "]"

On Error GoTo 0

SQL = "CREATE TABLE [" & TblName & "] (" & Mid(SQL, 2) & ")"

Set DB = CurrentDb

DB.Execute SQL

Set RS = DB.OpenRecordset(TblName, dbOpenDynaset)

For Row = 2 To WordTbl.Rows.Count

RS.AddNew

For Col = 1 To WordTbl.Columns.Count

WordTbl.Cell(Row, Col).Select

Tmp = WordObj.Selection.Text

Res = ""

For I = Len(Tmp) To 1 Step -1

If Asc(Mid(Tmp, I, 1)) >= 32 Then

Res = left(Tmp, I)

Exit For

End If

Next I

If Res = "" Then

RS(Col - 1) = Null

Else

RS(Col - 1) = Res

End If

Next Col

RS.UpDate

Next Row

Next WordTbl

WordObj.Documents.Close

Set WordObj = Nothing

End Function



... ist aber grottenlangsam (wobei sich sicher am Verfahren feilen läßt...)



Wenn die Tabelle schon besteht (und in Spaltenzahl usw. übereinstimmt) kann man die Word-Tabelle auch per Zwischenablage kopieren - ansonsten halt mit dem bekannten Umweg über Excel.


Gruß aus dem Norden
Reinhard


Bitte immer die Access-Version angeben!
DB-Wiki


Wie man Fragen richtig stellt

YaccessAccess-FAQUnd ansonsten: Wikipedia




geschrieben von

Login

E-Mail:
  

Passwort:
  

Beitrag anfügen

Symbol:
 
 
 
 
 
 
 
 
 
 
 
 
 

Überschrift: