How to extract data from this website with VBA queryselector

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!

Solution

Note:

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:

Accessing a website with Referer using WinHttpRequest.
Converting a byte array to text by decoding responseBody with ADODB.Stream. (The responseText is not decoded correctly.)

Add two refereneces in VBE

Microsoft HTML Object Library
Microsoft WinHTTP Services, version 5.1


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