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

Question

我正在尝试在不打开浏览器的情况下使用 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 代码？我也尝试了 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>

Answer 1

您错过了 header，它在获取内容方面起着重要作用。试试这个方法：

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

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

No response form website using MSXML2.XMLHTTP with POST and GET

excel

vba

get

xmlhttprequest

web-scraping