Question

我一直在使用IE从Excel中抓取这个网站，但最近使用IE已经不一致且速度慢。我的列表通常在500到1000左右，所以我必须在晚上运行宏。最近宏开始挂断。这就是为什么我决定第一次使用MSXML2进行探索。

网站不需要身份验证，但隐藏的输入会动态更改。

我做了什么..我使用GET拉取网站并提取动态密钥，然后尝试使用POST将输入数据发送到网站。我一直在收到服务器错误/运行时错误。我尝试使用不同的标头请求选项，但我仍然没有得到结果页面。我也尝试使用MSXML2.ServerXMLHTTP。我是在正确的轨道吗？

Sub test_66()

  Dim oXML_get
  'Dim oXML_post
  Dim sendText As String, s2 As String, n1 As Integer, postUrl As String,      sHTML As String, s1 As String

  ' Instantiate MSXML2
  Set oXML_get = New MSXML2.XMLHTTP
  oXML_get.Open "GET", "http://www.phila.gov/revenue/realestatetax/default.aspx", False
  oXML_get.setRequestHeader "Accept", "text/html;charset=UTF-8"
  oXML_get.setRequestHeader "Accept-Encoding", "identity"
  oXML_get.setRequestHeader "Accept-Charset", "UTF-8" 'Connection keep -alive
  oXML_get.setRequestHeader "Connection", "keep -alive"
  oXML_get.send
  sHTML = oXML_get.responseText
  'Debug.Print sHTML
  Dim hDOC As MSHTML.HTMLDocument
  Set hDOC = New MSHTML.HTMLDocument
  hDOC.body.innerHTML = sHTML
  s1 = Replace(hDOC.getElementsByTagName("input").Item(2).Value, "/", "%2F")
  s2 = Replace(hDOC.getElementsByTagName("input").Item(3).Value, "/", "%2F")
  sendText = "__VIEWSTATE=" & s1 & "&__EVENTVALIDATION=" & s2 & "&ctl00%24BodyContentPlaceHolder%24SearchByBRTControl%24txtTaxInfo=043185500&ctl00%24BodyContentPlaceHolder%24SearchByBRTControl%24btnTaxByBRT=%20>>"
  Debug.Print sendText '"__EVENTTARGET=&__EVENTARGUMENT=&__VIEWSTATE=" & s1 & "__EVENTVALIDATION=" & s2 & 
  oXML_get.Open "POST", "http://www.phila.gov/revenue/realestatetax/default.aspx", False
  oXML_get.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
  oXML_get.setRequestHeader "Accept", "text/html;charset=UTF-8"
  oXML_get.setRequestHeader "Accept-Encoding", "identity"
  oXML_get.setRequestHeader "Accept-Charset", "UTF-8" 'Connection keep -alive
  'oXML_get.setRequestHeader "Connection", "keep -alive"
  oXML_get.send (sendText)
  Dim objIE As Object: Set objIE = CreateObject("InternetExplorer.Application")
  objIE.navigate "about:blank"
  objIE.Visible = True
  objIE.document.Write oXML_get.responseText

End Sub

这是我得到的运行时错误消息....

Server Error in '/revenue/RealEstateTax' Application.
<!-- Web.Config Configuration File -->

<configuration>
    <system.web>
        <customErrors mode="Off"/>
    </system.web>
</configuration>

Answer 1

我已经在Firefox的网页上从网络表单提交了相同的搜索请求。之后我打开了开发人员工具 F12 ，网络选项卡，点击了上一个POST请求，打开了参数部分，这里是已经提交的参数的屏幕截图：

原始表格数据：

__ EVENTTARGET =安培; __ EVENTARGUMENT =安培; __ VIEWSTATE =％2FwEPDwULLTEyNDQ4MDU4OTkPZBYCZg9kFgICAw9kFgICDQ9kFgYCAQ9kFgICAw9kFgICAQ8QZBAVARUxNzAwIFNQUklORyBHQVJERU4gU1QVARUxNzAwIFNQUklORyBHQVJERU4gU1QUKwMBZxYBZmQCBQ8PFgIeBFRleHQFHFBsZWFzZSBhZGQgYWRkcmVzcyB0byBsb29rdXBkZAINDw8WAh4HVmlzaWJsZWhkFgoCAQ88KwAKAQAPFgQeC18hRGF0YUJvdW5kZx4LXyFJdGVtQ291bnRmZGQCAw9kFgICBQ8PFgIeF0VuYWJsZUFqYXhTa2luUmVuZGVyaW5naGRkAgUPFCsAAg8WAh8EaGQQFgJmAgEWAg8WBB4LTmF2aWdhdGVVcmwFJC4uL0ZlZWRiYWNrRm9ybS5hc3B4P0JydE5vPTc3MjUzNDcwMB8EaGQPFgQfBQUdfi9QREZzL1BheW1lbnRfQWdyZWVtZW50cy5wZGYfBGhkDxYCZmYWAQVxVGVsZXJpay5XZWIuVUkuUmFkV2luZG93LCBUZWxlcmlrLldlYi5VSSwgVmVyc2lvbj0yMDEwLjEuNTE5LjQwLCBDdWx0dXJlPW5ldXRyYWwsIFB1YmxpY0tleVRva2VuPTEyMWZhZTc4MTY1YmEzZDQWBGYPDxYEHwUFJC4uL0ZlZWRiYWNrRm9ybS5hc3B4P0JydE5vPTc3MjUzNDcwMB8EaGRkAgEPDxYEHwUFHX4vUERGcy9QYXltZW50X0FncmVlbWVudHMucGRmHwRoZGQCBw88KwARAgAPFgQfAmcfA2ZkARAWABYAFgBkAgkPFgIeBXZhbHVlBQk3NzI1MzQ3MDBkGAIFQWN0bDAwJEJvZHlDb250ZW50UGxhY2VIb2xkZXIkR2V0VGF4SW5mb0NvbnRyb2wkZ3JkUGF5bWV udHNIaXN0b3J5DzwrAAwBCGZkBTJjdGwwMCRCb2R5Q29udGVudFBsYWNlSG9sZGVyJEdldFRheEluZm9Db250cm9sJGZybQ9nZD9K5t7genscvOsiNrdPkxL0VHWCYSsS％2FK3EZTRu3h3w＆安培; __ EVENTVALIDATION =％2FwEWBQKkrNCPCgLRzsWTBwLlpIbACAKV6q2KDQKIvdHyCawQaHbBYSHV％2B％2FVvyLUTUY％2BhSsmbpTvj0W4ycfOa1RCO＆安培; ctl00％24BodyContentPlaceHolder％24SearchByAddressControl％24txtLookup =由+物业+地址＆安培; ctl00％24BodyContentPlaceHolder％24SearchByBRTControl％24txtTaxInfo = 043185500＆安培; ctl00％24BodyContentPlaceHolder％24SearchByBRTControl％24btnTaxByBRT = +％3E ％3E

请注意，有7个参数。所有这些都应该是URL编码的。我稍微修改并修改了您的代码，还添加了一些请求标头。以下代码对我来说是正确的：

Option Explicit

Sub test_66()

    Dim s1 As String
    Dim s2 As String
    Dim sResp As String
    Dim aTmp As Variant
    Dim sBRTNumber As String
    Dim sFormData As String

    With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", "http://www.phila.gov/revenue/realestatetax/default.aspx", False
        .setRequestHeader "Accept", "text/html;charset=UTF-8"
        .setRequestHeader "Accept-Encoding", "identity"
        .setRequestHeader "Accept-Charset", "UTF-8"
        .setRequestHeader "Connection", "keep-alive"
        .send
        sResp = .responseText
    End With
    aTmp = Split(sResp, "id=""__VIEWSTATE"" value=""", 2)
    s1 = aTmp(1)
    aTmp = Split(s1, """", 2)
    s1 = aTmp(0)
    aTmp = Split(sResp, "id=""__EVENTVALIDATION"" value=""", 2)
    s2 = aTmp(1)
    aTmp = Split(s2, """", 2)
    s2 = aTmp(0)
    s1 = EncodeUriComponent(s1)
    s2 = EncodeUriComponent(s2)

    sBRTNumber = "043185500"
    sFormData = Join(Array( _
        "__EVENTTARGET=", _
        "__EVENTARGUMENT=", _
        "__VIEWSTATE=" & s1, _
        "__EVENTVALIDATION=" & s2, _
        "ctl00%24BodyContentPlaceHolder%24SearchByAddressControl%24txtLookup=by+Property+Address", _
        "ctl00%24BodyContentPlaceHolder%24SearchByBRTControl%24txtTaxInfo=" & sBRTNumber, _
        "ctl00%24BodyContentPlaceHolder%24SearchByBRTControl%24btnTaxByBRT=+%3E%3E" _
        ), "&")

    With CreateObject("MSXML2.XMLHTTP")
        .Open "POST", "http://www.phila.gov/revenue/realestatetax/default.aspx", False
        .setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
        .setRequestHeader "Accept", "text/html;charset=UTF-8"
        .setRequestHeader "Accept-Encoding", "identity"
        .setRequestHeader "Accept-Charset", "UTF-8"
        .setRequestHeader "Connection", "keep-alive"
        .setRequestHeader "Host", "www.phila.gov"
        .setRequestHeader "Origin", "http://www.phila.gov"
        .setRequestHeader "Referer", "http://www.phila.gov/revenue/realestatetax/default.aspx"
        .send (sFormData)
        sResp = .responseText
    End With

    With CreateObject("InternetExplorer.Application")
        .navigate "about:blank"
        .Visible = True
        .document.write sResp
    End With

End Sub

Function EncodeUriComponent(strText As String) As String
    Static objHtmlfile As Object
    If objHtmlfile Is Nothing Then
        Set objHtmlfile = CreateObject("htmlfile")
        objHtmlfile.parentWindow.execScript "function encode(s) {return encodeURIComponent(s)}", "jscript"
    End If
    EncodeUriComponent = objHtmlfile.parentWindow.encode(strText)
End Function

这是IE窗口输出：

XML web使用动态密钥抓取网站

1 个答案: