Web scrape problem

[gargamalebarbosa]

Hi,
I used the code from the link Şimdi herkes besanaliz.com da buluşuyor. Türkiyenin en kapsamlı bes analiz platformu. to fetch the entire table, but it failed. I couldn't retrieve the desired table. I kindly request your assistance.

thank you,

Sub test()
    Set rq = CreateObject("MSXML2.XMLHTTP")
    dt = "{'RaporParams':{'Url':'fonbul-fon-ara-bul-fon-ara','RaporParametreleri':[{'key':'IlkTarih','value':''},{'key':'SonTarih','value':'23/02/2024'}],'RaporKriter':{'VeriGrup':'FonKriter','Kriter':[{'key':'FonKategori','value':'307, 308, 309, 310, 311, 312, 313, 314, 315, 316, 318, 319, 320, 321, 322, 323, 324, 325, 326, 405, 406, 407, 327, 328, 329, 330, 333, 334, 337, 338, 339, 340, 341, 342, 404, 290, 291, 292, 293, 294, 295, 296, 297, 298, 299, 300, 301, 302, 303, 304, 305'},{'key':'AnaKategori','value':'290'},{'key':'AnaKategori','value':'290'},{'key':'FonYonetici','value':'0'},{'key':'DegerlemeTarihi','value':false}]}}}"
    dt = Replace(dt, "'", """")
    url = "https://www.besanaliz.com/FonBulPlusServis/fonbul/tr/RaporTabloHesapla?key=YtBTs2R0OjoluczSy3RxOI4ah4NSMFPuOHfaQpkwnMneqEugUhaxwk/eA9V6IYif9GRSQnjW2vLi4mc6pck8q7hHRfGR1/395t3hEloIRlfGFFhAyMe5EfEErqGJgIdBEvLni4lr7+M0Iw3P2nI+0qTDaEE208FjwTqVrXK/RxFylxtXOZ6AqEzYEn9xcPKhHBH0Ic1i/cIAz00d21WbUuLl7z3slDiPttebMyDlh9yVS0No4Zvk33+PCkCPPEW/C4wdqjKRuZ8+EcsNsG40alXtCDe+P7ieT3qf35D3IAbhxdJFsrOloWX3RTr2yyYg"
    rq.Open "POST", url, False
    rq.setrequestHeader "Accept", "application/json, text/javascript, /; q=0.01"
    rq.setrequestHeader "Accept-Encoding", "gzip, deflate, br, zstd"
    rq.setrequestHeader "Accept-Language", "en-GB,en;q=0.9,tr-TR;q=0.8,tr;q=0.7,en-US;q=0.6"
    rq.setrequestHeader "Content-Type", "application/json; charset=UTF-8"
    rq.setrequestHeader "X-Requested-With", "XMLHttpRequest"
    rq.send (dt)
    Do
        DoEvents:
    Loop Until rq.ReadyState = 4
    MsgBox rq.responsetext
End Sub

 

[John_w]

Try this macro.

I've made a few changes to your code:

1. Uses "WinHttp.WinHttpRequest.5.1" instead of "MSXML2.XMLHTTP". I don't know why, but the POST request was returning status 405, Method Not Allowed with the latter.

2. You need to GET the initial form page, https://www.besanaliz.com/FonAraBul/FonAraForm, and extract the session key from the returned HTML response. This key is then specified in the URL for the subsequent POST request.

3. The POST response is a long JSON string, so you'll need a VBA JSON routine to parse it, e.g. VBA-JSON/JsonConverter.bas at master · VBA-tools/VBA-JSON, and write your own code to write the values in the parsed Dictionary to cells. However, in this case it's probably easier to scrape the web page using IE and HTMLDocument or Edge/Chrome and Selenium automation, rather than the WinHttpRequest method.

4. The minimum request headers for the POST seem to be "Accept", "Content-Type" and "Referer".

Public Sub test2()

    Dim rq As Object, dt As String
    Dim baseURL As String
    Dim sessionKey As String, p1 As Long, p2 As Long
    
    baseURL = "https://www.besanaliz.com"
    Set rq = CreateObject("WinHttp.WinHttpRequest.5.1")
    
    'Request web page and extract sessionKey string from it - 320 characters long.  This is specified in the subsequent POST request
    With rq
        .Open "GET", baseURL & "/FonAraBul/FonAraForm", False
        .setRequestHeader "Accept", "text/html,application/xhtml+xml,application/xml;q=0.9,image/avif,image/webp,*/*;q=0.8"
        .send
        Debug.Print .Status, .statusText
        p1 = InStr(.responseText, "var sessionKey = ")
        p1 = p1 + Len("var SessionKey = ")
        p2 = InStr(p1, .responseText, "';")
        sessionKey = Mid(.responseText, p1 + 1, p2 - p1 - 1)
    End With
    
    dt = "{'RaporParams':{'Url':'fonbul-fon-ara-bul-fon-ara','RaporParametreleri':[{'key':'IlkTarih','value':''},{'key':'SonTarih','value':'23/02/2024'}],'RaporKriter':{'VeriGrup':'FonKriter','Kriter':[{'key':'FonKategori','value':'307, 308, 309, 310, 311, 312, 313, 314, 315, 316, 318, 319, 320, 321, 322, 323, 324, 325, 326, 405, 406, 407, 327, 328, 329, 330, 333, 334, 337, 338, 339, 340, 341, 342, 404, 290, 291, 292, 293, 294, 295, 296, 297, 298, 299, 300, 301, 302, 303, 304, 305'},{'key':'AnaKategori','value':'290'},{'key':'AnaKategori','value':'290'},{'key':'FonYonetici','value':'0'},{'key':'DegerlemeTarihi','value':false}]}}}"
    dt = Replace(dt, "'", """")
    
    With rq
        .Open "POST", baseURL & "/FonBulPlusServis/fonbul/tr/RaporTabloHesapla?key=" & sessionKey, False
        .setRequestHeader "Accept", "application/json, text/javascript, */*; q=0.01"
        .setRequestHeader "Content-Type", "application/json; charset=utf-8"
        .setRequestHeader "Referer", "https://www.besanaliz.com/FonAraBul/FonAraForm"
        .send (dt)
        Debug.Print .Status, .statusText
        MsgBox .responseText
    End With
    
End Sub

 

[gargamalebarbosa]

Thank you.