Question

我正在尝试使用excel单元格中的数据搜索提交HTML表单的正确方法，并检索部分结果。

HTML表单网址为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列中的相应单元格中。

我已经回顾了几个类似的问题，但他们似乎使用了一些不同的格式，并不适合这种情况。

Answer 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

对我来说输出如下：

提交表单方法发布并检索数据

1 个答案: