HI Thorben
"....und in einen bestimmten Bereich in Excel einfügt....."
Cool - hätte ich meine Glaskugel nicht gerade an David Copperfield ausgeliehen (ohne mich wäre der aufgeschmissen!!) - dann wüsste ich sofort, um welchen Bereich es sich handelt....
...eine qualifizierte Antwort erwartet eine qualifizierte Fragestellung...
Deswegen habe ich nun als "Bereich" Spalte A und Zeile 1 festgesetzt, und jeder nächste Datensatz wird in die nächste freie Zeile geschrieben - du musst den Code, wenn er denn auch bei dir funktioniert - also noch selbst anpassen.
Wenn der Inhalt der Word-Dateien vom Aufbau her immer gleich ist - also immer gleiche Überschriftenzeile, immer gleiche Anzahl an Datenspalten, jede Spalte durch ; getrennt (egal, ob Wert vorhanden oder nicht) und immer nur 2 Zeilen (Überschriften- und Datenzeile) - dann versuch es mal mit diesem Code:
(die Exceldatei muss im selben Verz. wie die Word-Dateien gespeichert sein)
Sub Hausverw()
Cells.Clear
Dim lstrWdFile As String, loZeile As Long
lstrWdFile = Dir(ThisWorkbook.Path & "\*.doc")
loZeile = 1
Application.ScreenUpdating = False
Do Until lstrWdFile = ""
Open ThisWorkbook.Path & "\" & lstrWdFile For Binary As #1
Do While Not EOF(1)
Line Input #1, zeile
If InStr(1, zeile, "Obj") > 0 Then
Range("A" & loZeile).Value = zeile
Exit Do
End If
Loop
Close
Range("A" & loZeile).Value = Right(Range("A" & loZeile).Value, Len(Range("A" & _
loZeile).Value) - InStr(1, Range("A" & loZeile).Value, ""))
Range("A" & loZeile).Value = Replace(Range("A" & loZeile).Value, "/", "(")
Range("A" & loZeile).TextToColumns Destination:=Range("A" & loZeile), _
DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
Semicolon:=True, FieldInfo:=Array(Array(1, 1), _
Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), _
Array(6, 1), Array(7, 1), Array(8, 1), Array(9, 1), _
Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1)), _
TrailingMinusNumbers:=True
Range("E" & loZeile).Value = "'" & Replace(Range("E" & loZeile).Value, "(", "/")
lstrWdFile = Dir
loZeile = loZeile + 1
Loop
Application.ScreenUpdating = True
End Sub
Codeablauf:
1. Um den Code mehrfach zu verwenden, werden zuerst alle Zellen gelöscht
2. Die Variable lstrWdFile erhält aus dem Verzeichnis, in dem die Excel-Datei gespeichert ist, den Namen der ersten Word-Datei
3. Die Do/Loop-Schleife wird gestartet
4. Zuerst wird die Word-Datei im Binär-Mode zeilenweise eingelesen
(hier bin ich nicht sicher, ob im Binär-Modus so "gearbeitet" werden kann - auch wenn mein Code funktioniert. DAher bitte ich die, die sich hier besser auskennen, um Feedback und/oder Code-Korrektur, wenn erforderlich)
5. Sobald die Zeile gefunden wurde, in der der Textteil "Obj" vorkommt - die Überschriftenzeile - werden sowohl Überschriften- als auch Datenzeile in die erste freie Zeile in Excel geschrieben, und die Word-Datei wird geschlossen
6. Im nächsten Schritt wird die Überschriftenzeile entfernt
7. Dann wird in der verbleibenden Datenzeile das Zeichen "/" durch "(" ersetzt, da ein späterer Zellwert "1/1" (Wohnung) von Excel als Datum interpretiert und entsprechend umgewandelt wird, was hier nicht erwünscht ist
8. Jetzt wird die Datenzeile, die noch komplett in Zelle A steht, durch die ; auf so viel Spalten verteilt, wie erforderlich
9. Nun wird das in 7. gesetzte Zeichen "(" wieder in "/" umgewandelt - damit nicht wieder ein Datumswert entsteht, wird diesem Zellinhalt gleichzeitig ein Apostroph vorgesetzt, damit Excel diesen Zellwert als Text behandelt
Konnte ich helfen?
Ciao
Thorsten