AW: Text aus htm-Datei in verschiedene Excel Spalten
21.03.2019 13:15:56
Zwenn
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