无法让宏获取表格内容发出 post 个 http 请求

Question

我一直在尝试从 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 中获取表格内容以获得所需的响应。我尝试使用以下尝试来模仿相同的内容，但我总是得到此 0|error|500|| 作为响应。但是，当我在 python.

中遵循相同的逻辑时，我得到了必需的响应

如何从 Player Interests 选项卡中获取表格内容？请注意，我没有更改其他下拉选项中的任何内容来手动填充结果。

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

Answer 1

我可以通过注释掉这一行来让它工作：

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

Answer 2

我假设您对 ID 为 ctl00_ctl00_ContentTopLevel_ContentPlaceHolder1_radgInterests_ctl00 的 table 感兴趣。

我可以使用以下代码获取 table：

Sub Test()
    Const url As String = "https://www.perfectgame.org/College/CollegeCommitments.aspx?tab=interest"
    
    Dim xmlhttp As XMLHTTP60
    Set xmlhttp = New XMLHTTP60
    
    xmlhttp.Open "GET", url, False
    xmlhttp.send
    
    Dim htmldoc As HTMLDocument
    Set htmldoc = New HTMLDocument
    htmldoc.body.innerHTML = xmlhttp.responseText
    
    Debug.Print Not htmldoc.getElementById("ctl00_ctl00_ContentTopLevel_ContentPlaceHolder1_radgInterests_ctl00") Is Nothing
End Sub

无法让宏获取表格内容发出 post 个 http 请求

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

excel

vba

web-scraping

http-post