Word text nach Excel kopieren

Bischofs · 2008-02-12T16:49:00+00:00

Hallo zusammen, da ich totaler Excel Anfänger bin, benötige ich Hilfe bei folgendem Problem: Es gilt ein Makro in Excel zu schreiben, welches aus einer/mehreren Word Datei(en) einen bestimmten Textbereich nach Excel kopiert. In der Word Datei befindet sich eine Tabelle (5 Zeilen, 2 Spalten). In der 4. Zeile, 1. Spalte steht immer "Ansprechpartner", den Text in der 4. Zeile, 2. Spalte muss nach Excel kopiert werden. Wie bekommt man das hin? Viele Grüße, Ingo

Hi Renée,
ein totaler Anfänger bin ich nun auch nicht.
Hab das Coding schon soweit hinbekommen, dass in der Excel Datei die Dateinamen und das erste Wort der Word Datei ausgelesen werden:
Option Explicit


Sub Makro1()
Dim AppWd As Object
Dim DocWd As Object
Dim WordDatei As String
Dim WordDateiPfad As String
Dim TextWD As String
Dim DateiName As String
Dim aktZeile As Integer
'DateiName = Namer deiner ExcelDatei
DateiName = Application.ActiveWorkbook.Name
'der Pfad in dem die Word Dateien liegen, muss mit "\" enden
WordDateiPfad = "C:\Documents and Settings\s211525\Desktop\Test\"
'Startzeile in der Excel-Datei
aktZeile = 2
'Word-Object erzeugen und öffnen
Set AppWd = CreateObject("Word.Application")
'Schleife für alle Word-Dateien im Verzeichnis
WordDatei = Dir(WordDateiPfad & "*.doc")
Do While WordDatei  ""
'Datei Öffnen (unsichtbar)
AppWd.Visible = False
Set DocWd = AppWd.Documents.Open(WordDateiPfad & WordDatei)
'Erste Zeile der Word-Datei auslesen
DocWd.Range(0, 0).Select
TextWD = DocWd.Bookmarks("\Line").Range.Text
'In Excel schreiben
Workbooks(DateiName).Worksheets(1).Range("D" & aktZeile).Value = TextWD
Workbooks(DateiName).Worksheets(1).Range("C" & aktZeile).Value = WordDatei
aktZeile = aktZeile + 1
'aktuelle Worddatei schließen
DocWd.Close savechanges:=False
'nächste Word Datei
WordDatei = Dir()
Loop
'Word schließen und Objekt beenden
AppWd.Quit
Set DocWd = Nothing
End Sub

Das Problem besteht leider nur darin, dass ich es nicht hinbekomme, den Text aus der Word-Tabelle (4. Zeile, 2. Spalte) auszulesen.
Viele Grüße,
Ingo

Hi Ingo,
ungefähr in der Art, den Else-Block kannst Du natürlich weglassen!


Sub WordDateiBearbeiten()
On Error Resume Next
Set ObjWinWord = GetObject(, "Word.Application.8")
If Err.Number  0 Then
Err.Clear
Set ObjWinWord = CreateObject("Word.Application.8")
ObjWinWord.Visible = True
ObjWinWord.WindowState = wdWindowStateMaximize
Else
ObjWinWord.Activate
ObjWinWord.Visible = True
ObjWinWord.WindowState = wdWindowStateMaximize
End If
'öffnet Document
ObjWinWord.Documents.Open "C:\Temp\Ansprechpartner.doc"
Set DocWord = ObjWinWord.ActiveDocument
Set meineZelle = DocWord.Tables(1).Cell(Row:=4, Column:=2)
Set Ansprechpartner = DocWord.Tables(1).Cell(Row:=4, Column:=1)
'Prüfen, ob Zeichenkette "Ansprechpartner" in Z4S1 enthalten ist
If InStr(1, Ansprechpartner, "Ansprechpartner") > 0 Then
Worksheets(1).Cells(4, 4).Value = meineZelle
Else
MsgBox "Kein Ansprechpartner vorhanden"
End If
'schließt Document und Winword
DocWord.Close
ObjWinWord.Quit
Set ObjWinWord = Nothing
Set DocWord = Nothing
End Sub

Gruß
Ralf
www.joomlaworker.de

Forumthread: Word text nach Excel kopieren

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

Infobox / Tutorial