Follow

Keep Up to Date with the Most Important News

By pressing the Subscribe button, you confirm that you have read and are agreeing to our Privacy Policy and Terms of Use
Contact

Unable to let a macro fetch tabular content issuing post http requests

I’ve been trying to get tabular content from a webpage using xmlhttp requests. I’m interested in the table populated upon clicking on the Player Interests tab. When I observe network activity I could learn that a post http requests along with appropriate parameters is issued to this url to get the required response. I tried to mimic the same using the following attempt but I always get this 0|error|500|| as response. However, I got required response when I follow the same logic in python.

How can I get tabular content from Player Interests tab? Please note that I didn’t change anything in other dropdown options to populate the results manually.

Option Explicit
Public Sub GetContent()
    Const sBase = "https://www.perfectgame.org"
    Const Url$ = "https://www.perfectgame.org/College/CollegeCommitments.aspx?tab=interest"
    Dim oHtml As HTMLDocument, MyDict As Object
    Dim DictKey As Variant, payload$, oHttp As Object
    Dim HTML As HTMLDocument

    Set HTML = New HTMLDocument
    Set oHtml = New HTMLDocument
    Set oHttp = CreateObject("MSXML2.XMLHTTP")
    Set MyDict = CreateObject("Scripting.Dictionary")
    
    With oHttp
        .Open "GET", Url, True
        .setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 6.1) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/84.0.4147.135 Safari/537.36"
        .send
        While .readyState < 4: DoEvents: Wend
        oHtml.body.innerHTML = .responseText
    End With

    MyDict("ctl00$ctl00$ScriptManager2") = "ctl00$ctl00$ContentTopLevel$ContentPlaceHolder1$MainUpdatePanel|ctl00$ctl00$ContentTopLevel$ContentPlaceHolder1$lbInterest"
    MyDict("__EVENTTARGET") = "ctl00$ctl00$ContentTopLevel$ContentPlaceHolder1$lbInterest"
    MyDict("__EVENTARGUMENT") = ""
    MyDict("__LASTFOCUS") = ""
    MyDict("__VIEWSTATE") = oHtml.getElementById("__VIEWSTATE").Value
    MyDict("__VIEWSTATEGENERATOR") = oHtml.getElementById("__VIEWSTATEGENERATOR").Value
    MyDict("__EVENTVALIDATION") = oHtml.getElementById("__EVENTVALIDATION").Value
    MyDict("ctl00$ctl00$ContentTopLevel$HeaderTop$ghtys") = ""
    MyDict("ctl00$ctl00$ContentTopLevel$HeaderTop$tbGreen") = ""
    MyDict("ctl00$ctl00$ContentTopLevel$HeaderTop$tbDarkBlue") = ""
    MyDict("ctl00_ctl00_ContentTopLevel_ContentPlaceHolder1_ucCommitMenu_radsocialProfile_ClientState") = ""
    MyDict("ctl00$ctl00$ContentTopLevel$ContentPlaceHolder1$ddlYear") = "2022"
    MyDict("ctl00$ctl00$ContentTopLevel$ContentPlaceHolder1$ddlDivision") = "D1"
    MyDict("ctl00$ctl00$ContentTopLevel$ContentPlaceHolder1$ddlColleges") = "1756"
    MyDict("ctl00$ctl00$ContentTopLevel$ContentPlaceHolder1$ddlStates") = "0"
    MyDict("ctl00$ctl00$ContentTopLevel$ContentPlaceHolder1$radgInterests$ctl00$ctl03$ctl01$PageSizeComboBox") = "50"
    MyDict("ctl00_ctl00_ContentTopLevel_ContentPlaceHolder1_radgInterests_ctl00_ctl03_ctl01_PageSizeComboBox_ClientState") = ""
    MyDict("ctl00_ctl00_ContentTopLevel_ContentPlaceHolder1_radgInterests_ClientState") = ""
    MyDict("ctl00$ctl00$ContentTopLevel$Footer1$rcbPGSpecialEvents") = "PG Special Events"
    MyDict("ctl00_ctl00_ContentTopLevel_Footer1_rcbPGSpecialEvents_ClientState") = ""
    MyDict("ctl00$ctl00$ContentTopLevel$Footer1$rcbTravel") = "Travel, Lodging, Entertainment"
    MyDict("ctl00_ctl00_ContentTopLevel_Footer1_rcbTravel_ClientState") = ""
    MyDict("ctl00$ctl00$ContentTopLevel$Footer1$rcbPartners") = "PG Partners"
    MyDict("ctl00_ctl00_ContentTopLevel_Footer1_rcbPartners_ClientState") = ""
    MyDict("ctl00$ctl00$ContentTopLevel$Footer1$rcbRecommended") = "Recommended"
    MyDict("ctl00_ctl00_ContentTopLevel_Footer1_rcbRecommended_ClientState") = ""
    MyDict("ctl00$ctl00$hfpagetype") = ""
    MyDict("ctl00$ctl00$hfpassingid") = ""
    MyDict("ctl00$ctl00$hfsport") = ""
    MyDict("ctl00$ctl00$hfstate") = ""
    MyDict("ctl00$ctl00$hfzipcodes") = ""
    MyDict("hiddenInputToUpdateATBuffer_CommonToolkitScripts") = "1"
    MyDict("__ASYNCPOST") = "true"
    
    payload = ""
    For Each DictKey In MyDict
        On Error Resume Next
        payload = IIf(Len(DictKey) = 0, Application.EncodeURL(DictKey) & "=" & Application.EncodeURL(MyDict(DictKey)), _
        payload & "&" & Application.EncodeURL(DictKey) & "=" & Application.EncodeURL(MyDict(DictKey)))
        On Error GoTo 0
    Next DictKey

    With oHttp
        .Open "POST", Url, True
        .setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/99.0.4844.51 Safari/537.36"
        .setRequestHeader "Content-type", "application/x-www-form-urlencoded; charset=UTF-8"
        .setRequestHeader "Host", "www.perfectgame.org"
        .setRequestHeader "Origin", "https://www.perfectgame.org"
        .setRequestHeader "Referer", "https://www.perfectgame.org/College/CollegeCommitments.aspx"
        .setRequestHeader "X-MicrosoftAjax", "Delta=true"
        .setRequestHeader "X-Requested-With", "XMLHttpRequest"
        .setRequestHeader "Accept", "*/*"
        .setRequestHeader "accept-Encoding", "gzip , deflate, br"
        .send (payload)
        While .readyState < 4: DoEvents: Wend
        Debug.Print .responseText
        HTML.body.innerHTML = .responseText
        MsgBox HTML.querySelector("table[id='ctl00_ctl00_ContentTopLevel_ContentPlaceHolder1_radgCommitment_ctl00'] tbody tr[class*='Row']").innerText
    End With
    
End Sub

MEDevel.com: Open-source for Healthcare and Education

Collecting and validating open-source software for healthcare, education, enterprise, development, medical imaging, medical records, and digital pathology.

Visit Medevel

>Solution :

I was able to get it working by commenting out this line:

.setRequestHeader "Content-type", "application/x-www-form-urlencoded; charset=UTF-8"
Add a comment

Leave a Reply

Keep Up to Date with the Most Important News

By pressing the Subscribe button, you confirm that you have read and are agreeing to our Privacy Policy and Terms of Use

Discover more from Dev solutions

Subscribe now to keep reading and get access to the full archive.

Continue reading