htmlvbaqueryselectorreferermsxml2

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)

Public Website

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:


    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