I need to extract the 'href' from the html code of this website that is public and without any login:
(To access the page via xmlhttp, it needs a REFERER, that is posted as REFSTRING)
All my codes have failed, so I made the following attempt:
Function CheckIfAccess()
Dim html As MSHTML.HTMLDocument, xhr As Object, Headers As Variant
URL As String, RefString As String, CountItems As Long
Set html = New MSHTML.HTMLDocument
Set xhr = CreateObject("MSXML2.ServerXMLHTTP.6.0")
URL = "https://www.zvg-portal.de/index.php?button=showZvg&zvg_id=5972&land_abk=br"
RefString = "https://www.zvg-portal.de/index.php?button=Suchen"
With xhr
.Open "POST", URL, False
.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
.send RefString
html.body.innerHTML = .responseText
End With
CountItems = html.querySelectorAll("a").length
MsgBox (CountItems)
End Function
The Messegabox always shows ZERO, So the code can not even determine the number of 'a'. The thing is that exactly this code worked in the past perfectly:
GetHref = html.querySelectorAll("a").Item(x).innerText
...but now suddenly no longer!
Is there any blocking in HTML code or does my code need to be adjusted?
Thanks!
Please remember that repeatedly checking site accessibility can resemble a DDoS attack. Use the feature responsibly and avoid excessive requests to prevent unintended disruptions.
Changes:
Referer
using WinHttpRequest
.responseBody
with ADODB.Stream
. (The responseText
is not decoded correctly.)Add two refereneces in VBE
Changes:
- Accessing a website with `Referer` using `WinHttpRequest`.
- Converting a byte array to text by decoding `responseBody` with `ADODB.Stream`.
---
Add two refereneces in VBE
- Microsoft HTML Object Library
- Microsoft WinHTTP Services, version 5.1
```vb
Option Explicit
Sub CheckIfAccess()
Dim htmlDoc As MSHTML.HTMLDocument, oWHR As Object, htmlText As String
Dim sURL As String, RefString As String, CountItems As Long
Set htmlDoc = New MSHTML.HTMLDocument
Set oWHR = New WinHttp.WinHttpRequest
sURL = "https://www.zvg-portal.de/index.php?button=showZvg&zvg_id=13592&land_abk=be"
RefString = "https://www.zvg-portal.de/index.php?button=Suchen"
With oWHR
.Open "GET", sURL, False
' .setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
' .setRequestHeader "User-Agent", "Mozilla/5.0 (Linux; Android 6.0; Nexus 5 Build/MRA58N) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/125.0.0.0 Mobile Safari/537.36"
.setRequestHeader "Referer", RefString
.send
If .Status = 200 Then
htmlText = BytesToString(.responseBody)
' Debug.Print htmlText
htmlDoc.body.innerHTML = htmlText
CountItems = htmlDoc.querySelectorAll("a").Length
End If
End With
MsgBox CountItems
End Sub
Function BytesToString(byteArray) As String
Dim stream As Object
Set stream = CreateObject("ADODB.Stream")
With stream
.Type = 1
.Open
.Write byteArray
.Position = 0
.Type = 2
.Charset = "utf-8"
BytesToString = .ReadText
.Close
End With
Set stream = Nothing
End Function