Funktion um HTML auszulesen

Hallo zusammen,
ich nutze normalerweise die untenstehende Funktion, um den kompletten HTML-Code einer Website in Excel zu ziehen.
Bei bisher so gut wie allen Seiten hat das sehr gut funktioniert, leider jedoch nicht bei allen.
Vielleicht weiß hier jemand die Antwort wieso ich bspw. bei dieser Webseite einen Fehler angezeigt bekomme:
https://www.wlw.de/de/home
Bisheriger Code:

Public Function GetHTMLFromUrl(Url As String, Optional Truncate As Boolean = True) As String
Dim HTML As String
If Trim(Url) = "" Then
GetHTMLFromUrl = ""
Exit Function
End If
Application.ScreenUpdating = False
Application.EnableEvents = False
Set http = CreateObject("MSXML2.ServerXMLHTTP.6.0")
http.Open "GET", Url, False
If InStr(Url, "www.bing.com") > 0 Then
http.setRequestHeader "Cookie", "_FS=NU=1; _SS=C=21&SID= _
FF8518F34C5D4CB9959E34344A67E2EA&nhIm=84-&bIm=436110; MUID=28DBD393442D6387359FD701402D6338; SRCHD=SM=1&MS=2977313&D=2977313&AF=NOFORM; SRCHUSR=AUTOREDIR=0&GEOVAR=&DOB=20130829; WLS=TS=63513383977; _HOP=; SCRHDN=ASD=0&DURL=#; _FP=mkt=en-US; MUIDB=28DBD393442D6387359FD701402D6338; SRCHUID=V=2&GUID=A58450A50BFE45FAA775DB83DAC24EF6; SRCHHPGUSR=CW=1903&CH=976; FBS=WTS=1377787170555&CR=-1; DUP=Q=VSWU1Si3uP5NW4mD6cB8&T=178641577&IG=faac348ae8544e79bab57247ca4fd05f&V=1&A=2"
End If
http.setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 6.2; WOW64) AppleWebKit/537.36  _
(KHTML, like Gecko) Chrome/29.0.1547.62 Safari/537.36"
DoEvents
http.Send
DoEvents
HTML = http.responseText
If Truncate = True And Len(HTML) > 32767 Then
HTML = Left(HTML, 32767)
End If
GetHTMLFromUrl = HTML
Application.ScreenUpdating = True
Application.EnableEvents = True
End Function

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

…Christoph:
"_FS=NU=1; _SS=C=21&SID=FF8518F34C5D4CB9959E34344A67E2EA&nhIm=84-&bIm=436110; " & _
"MUID=28DBD393442D6387359FD701402D6338; SRCHD=SM=1&MS=2977313&D=2977313&AF=NOFORM; " & _
"SRCHUSR=AUTOREDIR=0&GEOVAR=&DOB=20130829; WLS=TS=63513383977; _HOP=; SCRHDN=ASD=0&DURL=#; " & _
"_FP=mkt=en-US; MUIDB=28DBD393442D6387359FD701402D6338; SRCHUID=V=2&GUID=" & _
"A58450A50BFE45FAA775DB83DAC24EF6; SRCHHPGUSR=CW=1903&CH=976; FBS=WTS=1377787170555&CR=-1; " & _
"DUP=Q=VSWU1Si3uP5NW4mD6cB8&T=178641577&IG=faac348ae8544e79bab57247ca4fd05f&V=1&A=2"
Anderenfalls macht das uU die Forumssoftware und die nimmt auf Texte keine Rücksicht, wodurch das Pgm unbrauchbar wdn kann.
Morhn, Luc :-?
Der beste Beweis für intelligentes Leben im Universum ist, dass noch niemand versucht hat, Kontakt mit uns aufzunehmen. H.Lesch, 2018, Sonneberg
Deshalb Intelligenz steigern mit

Function GetHTMLFromUrl(ByVal url As String, Optional Truncate As Boolean = True) As String Dim browser As Object Dim knotenWurzel As Object Dim htmlQuellCode As String Set browser = CreateObject("InternetExplorer.Application") browser.Visible = False browser.navigate url Do Until browser.ReadyState = 4: DoEvents: Loop Set knotenWurzel = browser.document.getElementsByTagName("html")(0) If Not knotenWurzel Is Nothing Then htmlQuellCode = knotenWurzel.outerHTML Else htmlQuellCode = "Kein HTML-Quellcode ausgelesen" End If If Truncate = True And Len(HTML) > 32767 Then htmlQuellCode = Left(htmlQuellCode, 32767) End If browser.Quit Set browser = Nothing GetHTMLFromUrl = htmlQuellCode End Function

Function GetHTMLFromUrl(ByVal url As String, Optional Truncate As Boolean = True) As String Dim browser As Object Dim knotenWurzel As Object Dim htmlQuellCode As String Set browser = CreateObject("InternetExplorer.Application") browser.Visible = False browser.navigate url Do Until browser.ReadyState = 4: DoEvents: Loop Set knotenWurzel = browser.document.getElementsByTagName("html")(0) If Not knotenWurzel Is Nothing Then htmlQuellCode = knotenWurzel.outerHTML Else htmlQuellCode = "Kein HTML-Quellcode ausgelesen" End If If Truncate = True And Len(htmlQuellCode) > 32767 Then htmlQuellCode = Left(htmlQuellCode, 32767) End If browser.Quit Set browser = Nothing GetHTMLFromUrl = htmlQuellCode End Function

Beliebteste Forumthreads (12 Monate)

3 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread