使用带有 POST 和 GET 的 MSXML2.XMLHTTP 的无响应表单网站

问题描述

我正在尝试使用 MSXML2.XMLHTTP 将数据从多个网站中的第二个传输到 Excel，而无需打开浏览器。意思是主主页在输入数据后创建一个查询页面（或查询内容）。

我的代码：

Sub GetData()

Dim HTML As New HTMLDocument,HTMLDoc As New HTMLDocument
    Dim elmt As Object
    Dim L As Long
    Const URL = "http://www.zvg-portal.de/index.PHP?button=Termine%20suchen"
    Const URL1 = "http://www.zvg-portal.de/index.PHP?button=Suchen"
         
    With CreateObject("MSXML2.XMLHTTP")
    .Open "POST",URL,False
    .send "land_abk=be&button=suchen"
    .Open "GET",URL1,False
    .send
    HTML.body.innerHTML = .responseText
    End With
               
    Set elmt = HTML.querySelectorAll("TR")
    For L = 0 To elmt.Length - 1
    ActiveSheet.Cells(L + 2,2) = elmt.Item(L).innerText
    Next

End Sub

什么都没发生。我认为这是因为无法访问查询内容或未构建查询内容。也许是因为错误的按钮代码？我也试过 button=submit 和 submit=true 和 suchen=true，但没有成功。如何解决这个问题？谢谢！

用于数据输入的主站点的 HTML：

<button type=submit>Suchen</button><button type=reset onClick="reset_form()">Zurücksetzen</button><br></h3></nobr><p>

<input type=hidden name=ger_name id=name=ger_name>

<!-- -->
<table border=0><tr><td ><b>Sortiert nach:&nbsp;</></td><td>
                <SELECT size=1 name=order_by><option value=2>Termin</option>
<option value=1>Aktualisierung</option>
<option value=3>Aktenzeichen</option>

</td> </tr>
</table>

<!--Land-->
<br>
<table border=0>
<tr><td><font color=red>*</font>&nbsp;<b>Land:</b></td></tr>
<tr><td>
<select size=1 name=land_abk onChange="updateAmtsgericht(this.value);" style="width:643px">
<option value=0>-- Bitte Bundesland ausw&auml;hlen --</option><option value='bw' >Baden-Wuerttemberg</option>
<option value='by' >Bayern</option>
<option value='be' >Berlin</option>

解决方法

您错过了在获取内容方面起着重要作用的标题。试试这种方式：

Sub GetData()
    Const URL = "http://www.zvg-portal.de/index.php?button=Suchen"
    Dim HTML As New HTMLDocument
    Dim elmt As Object,L As Long

    With CreateObject("MSXML2.XMLHTTP")
        .Open "POST",URL,False
        .setRequestHeader "Content-Type","application/x-www-form-urlencoded"
        .send ("land_abk=be")
        HTML.body.innerHTML = .responseText
    End With
               
    Set elmt = HTML.querySelectorAll("tr > td")
    For L = 0 To elmt.Length - 1
        Debug.Print elmt.Item(L).innerText
    Next L
End Sub