提交表单方法post和检索数据答案

【问题标题】：Submit form method post and retrieve data提交表单方法post和检索数据
【发布时间】：2016-10-20 09:34:01
【问题描述】：

我正在尝试寻找正确的方法来提交 HTML 表单以及来自 excel 单元格的数据并检索部分结果。

HTML 表单 URL 为 http://www2.stat.gov.lt:8777/imones/sektor.html:

<form action="sektor.chk_sekt" method="POST">
<br>
<b>Ūkio subjekto kodas: </b>
<input type="text" name="imone01" size="9" maxlength="9">
<br>
<br>
<input type="submit" value="  OK  ">
</form>

要提交的示例数据字符串为303305024、300983557，要从页面http://www2.stat.gov.lt:8777/imones/sektor.chk_sekt的响应中提取的值是以下行：

<BR>
<B>Veiklos rūšis pagal EVRK red. 2: </B>
479100 - Užsakomasis pardavimas paštu arba internetu
<BR>

A列中每个单元格的值应在循环内提交，检索到的结果应填入B列对应的单元格中。

我已经查看了几个类似的问题，但它们似乎使用了一些不同的表单格式，不适合这种情况。

【问题讨论】：

标签： forms vba excel post web-scraping

【解决方案1】：

以下是使用 XHR 和 RegEx 检索所需数据的示例：

Option Explicit

Sub RetriveData()

    Dim i As Long

    For i = 1 To Cells.Rows.Count
        If Cells(i, 1).Value = "" Then Exit For
        Cells(i, 2).Value = GetData(Cells(i, 1).Value)
    Next

End Sub

Function GetData(sCompany As String) As String

    Dim sContent As String

    With CreateObject("MSXML2.XMLHTTP")
        .Open "POST", "http://www2.stat.gov.lt:8777/imones/sektor.chk_sekt", False
        .Send "imone01=" & sCompany
        sContent = .ResponseText
    End With
    With CreateObject("VBScript.RegExp")
        .Global = True
        .MultiLine = True
        .IgnoreCase = True
        .Pattern = "<head>[\s\S]*?</head>|(?!<br>)<[^>]*>|[\r\n\t]*"
        sContent = .Replace(sContent, "")
        .Pattern = "<BR>Veiklos r\u016B\u0161is pagal EVRK red. 2: (.*?)<BR>"
        With .Execute(sContent)
            If .Count = 1 Then GetData = .Item(0).SubMatches(0) Else GetData = "n/a"
        End With
    End With

End Function

我的输出如下：

【讨论】：