从 HTML 元素中提取数据 - VBA

Question

我是网络抓取和 HTML 语言的新手。

我正在尝试在 VBA 中编写代码以从以下网站提取数据： https://companies.govmu.org:4343/MNSOnlineSearch/

我有一个 Excel 表，其中有超过 5000 个公司名称，它们分别在 A 和 B 列中的“文件号”，我需要在 C 列中输入它们的“状态”（“活动”或“已失效”）。这将在通过“文件编号”搜索每个公司，然后将其状态提取到 Excel 表后完成。

问题是我似乎无法获得包含我需要的数据的元素。

我已经编写了一段代码，它将从我的 Excel 工作表中提取“文件编号”，将其粘贴到网页上的“文件编号”搜索框中，然后运行搜索。 （您可以尝试搜索C5113，例如）。

但是，在生成的网页上，我尝试获取包含我需要的数据的元素，但它不起作用。

例如，我尝试了 MsgBox（MsgBox 是我个人的方式来检查我的变量是否包含我需要的数据）标签字段集（fs）的内部 HTML，ID 为“CompanyList”，如下面的代码所示，但是它返回一个错误。

我还尝试了另一个名为 div 的变量，其数据类型为 HTMLDivElement，然后通过 ID“companies”获取元素。

最后，我还尝试遍历 IHTMLElementCollection 类型的变量来查找我需要的元素，但它仍然没有显示我需要的元素（它显示了我不需要的其他元素） .

Option Explicit

Sub ExtractStatusDetails()
    Dim ie As InternetExplorer
    Dim html As HTMLDocument
    Dim resultHtml As HTMLDocument
    Dim fs As IHTMLElement
    Dim searchBoxes As IHTMLElementCollection
    Dim searchButton As Object
    Dim homePage As String

    homePage = "https://companies.govmu.org:4343/MNSOnlineSearch/"
    Set ie = New InternetExplorer   
    ie.Visible = False
    ie.navigate homePage
    Do While ie.readyState <> READYSTATE_COMPLETE
        DoEvents
    Loop

    Set html = ie.document
    Set searchBoxes = html.getElementsByClassName("col-md-6 col-lg-4")

    searchBoxes(0).innerHTML = Replace(searchBoxes(0).innerHTML, "placeholder", "value")
    searchBoxes(0).innerHTML = Replace(searchBoxes(0).innerHTML, "Search company by File No...", "C63")

    Set searchButton = searchBoxes(0).getElementsByClassName("btn btn-large btn-primary btn-raised")
    searchButton(0).Click
    Do While ie.readyState <> READYSTATE_COMPLETE
        DoEvents
    Loop

    Set resultHtml = ie.document
    Set fs = resultHtml.getElementById("CompanyList")

    MsgBox fs.innerHTML

    ie.Quit

End Sub

Answer 1

该页面执行 xmlhttp POST 请求，该请求从后端数据存储（可能是 Oracle GlassFish > JDBC API > 数据存储库，例如 MySQL）检索数据。它返回所有相似的匹配，可能包括精确匹配。

输入fileNo并按搜索键后，在浏览器开发工具的网络流量中可以找到POST请求。

下面是一个函数，您可以在 fileNos 上循环调用以检索公司状态

Option Explicit

Public Sub test()
    Dim fileNo As String, xmlhttp As Object
    fileNo = "C5113"
    Set xmlhttp = CreateObject("MSXML2.XMLHTTP")
    MsgBox GetCompanyStatus(fileNo, xmlhttp)
End Sub

Public Function GetCompanyStatus(ByVal fileNo As String, ByVal xmlhttp As Object) As String
    Dim html As HTMLDocument, body As String, fileNos As Object, i As Long

    Set html = New HTMLDocument
    body = "tabs=tab-1&searchByName=&searchByFileNo=PLACEHOLDER&submitCompanies=&searchByBusName=&searchByBRN=&searchByIncDateFrom=&searchByIncDateTo=&doAction=search"

    With xmlhttp
        .Open "POST", "https://companies.govmu.org:4343/MNSOnlineSearch/GetCompanies", False
        .setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
        .send Replace$(body, "PLACEHOLDER", fileNo)
        html.body.innerHTML = .responseText
        Set fileNos = html.querySelectorAll("td.tdFileNo")
        If fileNos.Length > 0 Then
            For i = 0 To fileNos.Length - 1
                If fileNos.item(i).innerText = fileNo Then
                    GetCompanyStatus = html.querySelectorAll("td.tdStatus").item(i).innerText
                    Exit Function
                End If
            Next i
        End If
        GetCompanyStatus = "Not found"
    End With
End Function

---

我会考虑如何对您的请求进行分组。由于您可以发布部分文件编号，因此您可以通过批量处理部分文件编号来显着减少请求数量，例如搜索 C5 或 C51；然后后端执行“C5%”之类的操作以返回以指定字符串开头的所有匹配项，然后循环搜索这些结果以搜索您感兴趣的文件编号，这些文件编号在该范围内。

您可以有一个字典，其中fileNo 作为键，status 作为值，并在循环请求返回的结果时更新它。我认为键的数量受Long 的限制，所以我认为在开始时将所有fileNos 存储在字典中并稍后在请求期间更新是没有问题的。您甚至可以拥有多个包含文件编号范围的字典，例如古老的大英百科全书卷。例如，这会将循环限制为您希望从同一请求中填充的 dicts。是一种可以探索的东西。