Text aus htm-Datei in verschiedene Excel Spalten

F · 2019-03-21T10:03:32+00:00

Hallo miteinander, da ich auf dem Gebiet Excel/VBA ein blutiger Anfänger und zweitens neu hier bin, hoffe ich auf Eure Hilfe. Konkret möchte ich bestimmte Texte aus dem Quelltext einer gespeicherten htm-Datei auf meinem PC in verschiedene Spalten von Excel übertragen. Hier einmal der Auszug einer Stelle: Blatt, 18.02.2019, Nr. 41, S. 4 Titel des Blattes mwe. Beispiel für den Text auf dem Blatt. Von Interesse ist das Wort Blatt. Fragen über Fragen So soll etwa alles zwischen untereinander in der Spalte A, in B und in C aufgeführt werden. Damit wären die Daten für mich übersichtlich als Datum/Titel/Text aufbereitet. Ganz herzlichen Dank für Eure Hilfe! Viele Grüße F

Hallo F,
folgendes Makro holt die gewünschten Daten über den Internet Explorer aus Deinem HTML-Dokument. Den Pfad zum Dokument musst Du natürlich anpassen. Die CSS-Klasse "Text" gibt es zweimal. Ich lese nur die erste aus. Wenn Du die zweite auch brauchst, muss die ergänzt werden.


Sub TextAusHTML()
'Variablen für den Internetzugriff und das DOM-Handling
Dim url As String
Dim browser As Object
Dim knotenStamm As Object
Dim knotenAst As Object
Dim knotenZweig As Object
Dim dokumentName As String
Dim titel As String
Dim text As String
Dim aktuelleZeile As Long
aktuelleZeile = 2
url = "G:\Rest\Herber Forum\Lokale HTML Datei Texte auslesen - F Meier\Daten für Excel.html"
'Internet Explorer initialisieren, Sichtbarkeit festlegen,
'URL aufrufen und warten bis Seite vollständig geladen wurde
Set browser = CreateObject("internetexplorer.application")
browser.Visible = False
browser.Navigate url
Do Until browser.ReadyState = 4: DoEvents: Loop
'Alle relevanten HTML-Abschnitte einsammeln
Set knotenStamm = browser.document.getElementsByClassName("single-document")
If Not knotenStamm Is Nothing Then
'Wenn vorhanden, alle eingesammelten HTML-Abschnitte durchgehen
For Each knotenAst In knotenStamm
'Dokumentname auslesen
Set knotenZweig = knotenAst.getElementsByClassName("docSource")(0)
If Not knotenZweig Is Nothing Then
'Wenn vorhanden, in Variable speichern
dokumentName = knotenZweig.innerText
End If
'Ttitel auslesen
Set knotenZweig = knotenAst.getElementsByClassName("docTitle")(0)
If Not knotenZweig Is Nothing Then
'Wenn vorhanden, in Variable speichern
titel = knotenZweig.innerText
End If
'Text auslesen
Set knotenZweig = knotenAst.getElementsByClassName("text")(0)
If Not knotenZweig Is Nothing Then
'Wenn vorhanden, in Variable speichern
text = knotenZweig.innerText
End If
'Ausgelesene Werte zum aktuellen HTML-Abschnitt (ein gefundener Artikel)
'in Tabelle schreiben Dieses Makro schreibt die Werte ab Zeile 2 in die
'Tabelle, aus der es gestartet wurde
Cells(aktuelleZeile, 1).Value = dokumentName
Cells(aktuelleZeile, 2).Value = titel
Cells(aktuelleZeile, 3).Value = text
'Nächste Zeile festlegen
aktuelleZeile = aktuelleZeile + 1
Next knotenAst
End If
'Aufräumen
browser.Quit
Set browser = Nothing
Set knotenStamm = Nothing
Set knotenAst = Nothing
Set knotenZweig = Nothing
End Sub

Viele Grüße,
Zwenn

Super Danke für Deine Hilfe!
Leider kommt jedoch die Meldung
Laufzeitfehler '-2147417848 (80010108)':
Automatisierungsfehler
Das aufgerufene Objekt wurde von den Clients getrennt
Hatte es jetzt mit verschiedenen Dateien versucht.


Sub TextAusHTML()
'Variablen für den Internetzugriff und das DOM-Handling
Dim url As String
Dim browser As Object
Dim knotenStamm As Object
Dim knotenAst As Object
Dim knotenZweig As Object
Dim dokumentName As String
Dim titel As String
Dim text As String
Dim aktuelleZeile As Long
aktuelleZeile = 2
url = "C:/Users/felix/Downloads/Rente$_18.10.2005_Politik_S75.htm"
'Internet Explorer initialisieren, Sichtbarkeit festlegen,
'URL aufrufen und warten bis Seite vollständig geladen wurde
Set browser = CreateObject("internetexplorer.application")
browser.Visible = False
browser.Navigate url
Do Until browser.ReadyState = 4: DoEvents: Loop
'Alle relevanten HTML-Abschnitte einsammeln
Set knotenStamm = browser.document.getElementsByClassName("single-document")
If Not knotenStamm Is Nothing Then
'Wenn vorhanden, alle eingesammelten HTML-Abschnitte durchgehen
For Each knotenAst In knotenStamm
'Dokumentname auslesen
Set knotenZweig = knotenAst.getElementsByClassName("docSource")(0)
If Not knotenZweig Is Nothing Then
'Wenn vorhanden, in Variable speichern
dokumentName = knotenZweig.innerText
End If
'Ttitel auslesen
Set knotenZweig = knotenAst.getElementsByClassName("docTitle")(0)
If Not knotenZweig Is Nothing Then
'Wenn vorhanden, in Variable speichern
titel = knotenZweig.innerText
End If
'Text auslesen
Set knotenZweig = knotenAst.getElementsByClassName("text")(0)
If Not knotenZweig Is Nothing Then
'Wenn vorhanden, in Variable speichern
text = knotenZweig.innerText
End If
'Ausgelesene Werte zum aktuellen HTML-Abschnitt (ein gefundener Artikel)
'in Tabelle schreiben Dieses Makro schreibt die Werte ab Zeile 2 in die
'Tabelle, aus der es gestartet wurde
Cells(aktuelleZeile, 1).Value = dokumentName
Cells(aktuelleZeile, 2).Value = titel
Cells(aktuelleZeile, 3).Value = text
'Nächste Zeile festlegen
aktuelleZeile = aktuelleZeile + 1
Next knotenAst
End If
'Aufräumen
browser.Quit
Set browser = Nothing
Set knotenStamm = Nothing
Set knotenAst = Nothing
Set knotenZweig = Nothing
End Sub

Jetzt habe ich schon mal ungefähr vor Augen wie das funktionieren soll
Viele Grüße

Text aus htm-Datei in verschiedene Excel Spalten

Forumthread: Text aus htm-Datei in verschiedene Excel Spalten

16
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Text aus htm-Datei in verschiedene Excel Spalten

Forumthread: Text aus htm-Datei in verschiedene Excel Spalten

16 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

16
Beiträge zum Forumthread

Beiträge zu diesem Forumthread