Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1728to1732
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Download von Webseiten als HTML

Download von Webseiten als HTML
13.12.2019 17:02:47
Webseiten
Hallo,
ich versuche, Webseiten mit VBA aufzurufen und als HTML-Seiten abzuspeichern. Ziel ist es rund 115000 Einträge in einem Forum zu archivieren. Mittels der Recherche habe ich einen Code gefunden und angepasst, der soweit funktioniert, allerdings sehr langsam ist.
Private Sub Splinters_Messages()
Dim appIE As Object
Dim sURL As String
Dim sTxt As Variant
For i = 1 To 200
sURL = "https://groups.yahoo.com/neo/groups/splinters/conversations/messages/" & i
Set appIE = CreateObject("InternetExplorer.Application")
appIE.navigate sURL
Do: Loop Until appIE.Busy = False
Do: Loop Until appIE.Busy = False
sTxt = appIE.document.DocumentElement.outerhtml
Set appIE = Nothing
Close
Open "C:\Users\Martin\Documents\Splinters_Messages\Messages" & i & ".html" For Output As #1
Print #1, sTxt
Close
Next i
End Sub

Gibt es eine Möglichkeit, die Aufgabe schneller zu erledigen? Ich habe hiermit experimentiert, was mit den Queltext liefert. Mit der auskommentierten Zeil wollte ich die HTML-Darstellung holen, aberdas funktioniert leider nicht.
Sub splinters_auslesen()
For i = 100 To 101
URL_Splinters = "https://groups.yahoo.com/neo/groups/splinters/conversations/messages/" & i 'Laden der URL
With CreateObject("MSXML2.XMLHTTP")
.Open "GET", URL_Splinters, False
.Send
Splinters_txt = .responseText
'Splinters_txt = .document.DocumentElement.outerhtml
End With
Cells(i, 1) = Splinters_txt
Next i
End Sub
Gruß
Martin

1
Beitrag zum Forumthread
Beitrag zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
Bad news my friend :-(
13.12.2019 22:28:58
Zwenn
Hallo Martin,
bist noch wach? ;-)
Verizon (Besitzer von Yahoo) sabotiert die Sicherung der Gruppen massiv:
https://www.heise.de/newsticker/meldung/Verizon-verhindert-in-letzter-Minute-Archivierung-der-Yahoo-Groups-4609371.html
Allerdings bist Du mit Deiner Frage auch sehr spät dran. Du kannst dies ausprobieren:
https://groups.io/g/GroupManagersForum/wiki/Transfer-from-Yahoo-Groups
Ich konnte keine Seite Deiner Links erreichen. Die erste nach Deinem Makro wäre folgende gewesen:
https://groups.yahoo.com/neo/groups/splinters/conversations/messages/1
(Oder ab Seite 100 mit dem zweiten Codeabschnitt.)
Edit (obwohl es nicht geht ;-): Seite 100 hat nun was ergeben, die ersten 10 Seiten (ab Seite 1) enthielten nur den Text The item you are looking for is not available.
Um die HTML Dateien zu sichern kannst Du das unten stehende Makro ausprobieren. Sollten die Yahoo Gruppen allerdings in Frames beherbergt sein, funktioniert das nicht! Dann müsste man nachbessern. Aufgrund der verbleibenden Stunden sehe ich da allerdings schwarz. (Sind sie nicht, wie ich inzwischen weiß.)
Die runtergeladenen HTML-Dateien korespondieren nicht untereinadner nehme ich an (die Verlinkungen funktionieren nicht). Aber wenn alle Postings gesichert werden können, kann man da im Nachhinein evtl. noch was machen.

Sub HoleHTML()
'Ich habe keine Ahnung, wie man durch die Seiten einer Yahoo Group blättert
'Der folgende Code holt den HTML Code mit Deiner "bis 200" For-Schleife!
'Ok, ich habe das sicherheitshalber auf 5000 erhöht ;-)
'Irgendwas wird schon passieren :-)
'Sollte die Seitenzählung wirklich erst bei 100 losgehen,
'bitte die For-Schleife anpassen (die zählt aktuell ab Seite 1)
'Alle HTML-Dateien werden im gleichen Ordner gespeichert,
'in dem die Datei liegt, die dieses Makro enthält
'Also speichere diese Makro unbedingt lokal in einer Datei!
'Sonst liegt alles im Temp-Ordner und das willst Du nicht ;-)
Dim browser As Object
Dim url As String
Dim knotenHTML As Object
Dim seite As Long
Dim htmlCode As String
Dim postingNr As Long
For seite = 100 To 5000
url = "https://groups.yahoo.com/neo/groups/splinters/conversations/messages/" & seite
'Internet Explorer initialisieren, Sichtbarkeit festlegen,
'URL aufrufen und warten bis Seite vollständig geladen wurde
'Sichtbarkeit lasse ich in diesem Fall mal bewusst auf True
Set browser = CreateObject("internetexplorer.application")
browser.Visible = True
browser.navigate url
Do Until browser.ReadyState = 4: DoEvents: Loop
'Gesamtes HTML der Seite abgreifen
Set knotenHTML = browser.document.getElementsByTagName("html")(0)
'Quelltext der Seite speichern
'(Fortlaufende Nummerierung. Keine Ahnung was zu welchem Thread gehört)
If Not knotenHTML Is Nothing Then
'Wenn es ein HTML-Dokument gibt
htmlCode = knotenHTML.outerHTML
Close
Open ThisWorkbook.Path & "\" & postingNr & ".htm" For Output As #1
Print #1, htmlCode
Close
postingNr = postingNr + 1
End If
'Aufräumen
browser.Quit
Set browser = Nothing
Set knotenHTML = Nothing
Next seite
End Sub
Schade, hätte gern früher geholfen.
Viele Grüße,
Zwenn
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige