Search code examples
vbahttp-redirectxmlhttprequest

Catch the POST Request Response and the Redirected URL from XMLHTTP request with VBA

I'm trying to catch a Response to a POST Request using XMLHTTP using the code below

Dim XMLPage As New MSXML2.XMLHTTP60
Dim HTMLDoc As New MSHTML.HTMLDocument

Dim htmlEle1 As MSHTML.IHTMLElement
Dim htmlEle2 As MSHTML.IHTMLElement

Dim URL As String
Dim elemValue As String

URL = "https://www.informadb.pt/pt/pesquisa/?search=500004064"


    XMLPage.Open "GET", URL, False
    XMLPage.send
    
    HTMLDoc.body.innerHTML = XMLPage.responseText
    
        
    For Each htmlEle1 In HTMLDoc.getElementsByTagName("div")
        Debug.Print htmlEle1.className
       If htmlEle1.className = "styles__SCFileModuleFooter-e6rbca-1 kUUNkj" Then
          
          elemValue = Trim(htmlEle1.innerText)
          If InStr(UCase$(elemValue), "CONSTITU") > 0 Then
                'Found Value
                Exit For
          End If
       End If
    Next htmlEle1

The problem is that I can't find the ClassName "styles__SCFileModuleFooter-e6rbca-1 kUUNkj", because I notice that when I manually insert the value (500004064) in the search box of the URL : https://www.informadb.pt/pt/pesquisa/, the Web Page generates addicinal traffic and turns up at an end point URL : https://www.informadb.pt/pt/pesquisa/empresa/?Duns=453060832, where that className can be found in the Request ResponseText.

My goal is to use the First URL to retrieve the Duns number '453060832', to be able to access the information in the ResponseText of the EndPoint URL. And to catch Duns Number, I need to find a way to get the Endpoint URL, or try to get The POST request response below, and get that value using JSON parser:

{'TotalResults': 1,
 'NumberOfPages': 1,
 'Results': [{'Duns': '453060832',
   'Vat': '500004064',
   'Name': 'A PANIFICADORA CENTRAL EBORENSE, S.A.',
   'Address': 'BAIRRO DE NOSSA SENHORA DO CARMO,',
   'Locality': 'ÉVORA',
   'OfficeType': 'HeadOffice',
   'FoundIn': None,
   'Score': 231.72766,
   'PageUrl': '/pt/pesquisa/empresa/?Duns=453060832'}]}

I'm not being able to capture what is really happening using the XMLHTTP Browser request, that seems to be the below steps:

  1. navigate to https://www.informadb.pt/pt/pesquisa/?search=500004064

  2. Webpage generates additional traffic

  3. Amongst that additional traffic is an API POST XHR request which returns search results as JSON. That request goes to https://www.informadb.pt/Umbraco/Api/Search/Companies and includes the 500004064 identifier amongst the arguments within the post body

  4. Based on the API results the browser ends up at the following URI https://www.informadb.pt/pt/pesquisa/empresa/?Duns=453060832

Can someone help me please, I have to do it using VBA. Thanks in advance.

Solution

  • A small example how to POST data to your website using VBA, and how to use bare-bones string processing to extract data from the result, as outlined in my comments above.

    Function GetVatId(dunsNumber As String) As String
    With New MSXML2.XMLHTTP60
        .open "POST", "https://www.informadb.pt/Umbraco/Api/Search/Companies", False
        .setRequestHeader "Content-Type", "application/json"
        .send "{""Page"":0,""PageSize"":5,""SearchTerm"":""" & dunsNumber & """,""Filters"":[{""Key"":""districtFilter"",""Name"":""Distrito"",""Values"":[]},{""Key"":""legalFormFilter"",""Name"":""Forma Jurídica"",""Values"":[]}],""Culture"":""pt""}"
        
        If .status = 200 Then
            MsgBox "Response: " & .responseText, vbInformation
            GetVatId = Mid(.responseText, InStr(.responseText, """Vat"":""") + 7, 9)
        Else
            MsgBox "Repsonse status " & .status, vbExclamation
        End If
    End With
End Function

    Usage:

    Dim vatId As String

vatId = GetVatId("453060832") ' => "500004064"

    For a more robust solution, you should use a JSON parser and -serializer, something like https://github.com/VBA-tools/VBA-JSON.