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

Question

我一直在尝试使用xmlhttp请求从网页获取表格内容。我对点击Player Interests选项卡时填充的表格很感兴趣。当我观察网络活动时，我可以了解到会向该url发出posthttp请求和适当的参数，以获得所需的响应。我试着用下面的尝试来模仿，但我总是得到这个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的表感兴趣。

我可以用下面的代码获取那张表：

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