word-datei inhalte in excel uebernehmen

das was in der word datei steht.

Danke erstmal für alle Antworten

Lonesome Walker hatt mich verstanden....

ich möchte aus einer aus einer geöffneten excel-arbeitsmappe gestartete Word datei einen Markierten Abschnitt in die geöffnete arbeitsmappe übernehmen.

Excel-arbeitsmappe - blatt1 feld A5 befragung_09_01_2001.doc -> öffnen

worddatei.find.....
if .find then
schreibe .selection in aktive excelmappe feld B5

Na ich wiß nicht ob das jetzt verständlicher ist?

was ich wissen möchte ist wie bekomme ich den selectierten bereich aus der aktiven worddatei in die active exceldatei in Feld xyz der gleichen reihe.

Danke

hier die function:

Function WordDatei_öffnen(worddatei As String)
Dim objWW As Object

On Error Resume Next
Set objWW = GetObject(, "Word.Application.9")

If Err.Number <> 0 Then
Err.Clear
Set objWW = CreateObject("Word.Application.9")
Else
objWW.Activate
End If

' das gewünschte Dokument öffnen
objWW.Documents.Add worddatei
'alles markieren
objWW.ActiveDocument.Select

'hier nun zu excel


End Function

was muß ich jetzt wo machen damit ich es in die excel-tabelle reinbekomme

wenn ich es mit copy / paste mache dann setzt excel den dateinamen ein weil ich ihn als erstes selektiert habe um die word-datei zu öffnen

Da ich keine guten oder sagen wir mal für mich machbare lösungswege bekommen habe möchte ich hier eine anregung bekanntgeben.
Hallo leute für mich habe ich es gelöst.
hier mein vorgehen:
Ich Habe eine Tabelle mit vielen Dateinamen (word) in einem verzeichniss
Diese Dateien haben infos die ich haben möchte und diese in eine tabelle schreibe

Dim texte As String hier steht das aus word ausgelese textelement drinn

Public Function dok_teil_suchenundspeichern(ByVal Target As Excel.Range, Cancel As Boolean)
Dim zelle As String
Dim exceldoc As Object
Dim xlMappe As Object
Dim strText As String
Dim arrTmp() As String
Dim arrTmpa() As String
Dim arrTmpe() As String
Dim arrTmpen() As String
Dim inhalt_1 As String
Dim inhalt_2 As String
Dim inhalt_3 As String

Dim i As Long
Dim ak_zeile As Long
Dim MaxRows
Dim NextRows

Set xlMappe = ActiveWorkbook

MaxRows = xlMappe.Worksheets("extrablatt").Cells.SpecialCells(11).Row
NextRows = MaxRows + 1

If Target.Cells.Column = 1 And Target.Text Like "*.doc" Then
dateisuchen (Target.Text)
End If

If texte <> "" Then
Mein problem waren Tabulatoren Chr(9) und Umbrüche Chr(13)

strText = Replace(texte, Chr(9), "")
strText = Replace(strText, Chr(13), "")
xlMappe.Worksheets("extrablatt").Cells(NextRows, 2) =strText
...
...heir kommt noch was aber für dieses unrelewant
...
End If

xlMappe.Worksheets("extrablatt").Cells(NextRows, 1) = Target.Text

End Function

Sub dateisuchen(datei)
Dim i
With Application.FileSearch
.NewSearch
.LookIn = "D:\temp\" 'hier suche ich nach der datei
.SearchSubFolders = True
.Filename = datei
.MatchTextExactly = True
.FileType = msoFileTypeAllFiles
If .Execute() > 0 Then
For i = 1 To .FoundFiles.Count
WordDatei_öffnen (.FoundFiles(i))
Next i
Else
MsgBox "keine Datei gefunden"
End If
End With
End Sub

Function WordDatei_öffnen(worddatei As String)

' hier wird die Datei geöffnet
' Da ich nur einen teil der Worddatei brauche mache ich ein range mit
' anfang -> antwPTW_A
' ende -> antwPTW_E


Dim wordObj As Object
Dim startPos
Dim endPos

On Error Resume Next
Set wordObj = GetObject(, "Word.Application.9")
If Err.Number <> 0 Then
Err.Clear
Set wordObj = CreateObject("Word.Application.9")
Else
wordObj.Activate
End If

' das gewünschte Dokument öffnen
wordObj.Documents.Add worddatei
'Set akwordobj = objWW.ActiveDocument
ActiveDocument.Selection.HomeKey Unit:=wdStory
ActiveDocument.Range
With ActiveDocument.Range.Find
.Text = "antwPTW_A"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = True
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
ActiveDocument.Range.Find.Execute
startPos = ActiveDocument.Range.Start
ActiveDocument.Range.Find.ClearFormatting
With ActiveDocument.Range.Find
.Text = "antwPTW_E"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = True
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
ActiveDocument.Range.Find.Execute
endPos = ActiveDocument.Range.End

ActiveDocument.Range(startPos, endPos).Find.Execute Replace:=wdReplaceAll
texte = ActiveDocument.Range(startPos, endPos)
texte = Replace(texte, Chr(9), "") ' Tabulatoren raus
texte = Replace(texte, Chr(13), "") ' Umbruche raus
'..... texte = Replace(texte, Chr(xyz), "") ' usw... kann aber auch mit einer schleife realisiert werden
ActiveDocument.Close
End Function

Wenn jemand fragen dazu Hat kann sich melden