Question

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

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

我有一个包含5000多个公司名称的Excel工作表，分别在A和B列中有各自的“文件编号”，我需要在C列中输入其“状态”（“实时”或“已终止”）。在通过“文件号”搜索每个公司并将其状态提取到Excel工作表之后，即可完成此操作。

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

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

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

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

我还尝试了另一个名为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）检索数据。它返回所有相似的匹配，可能包括精确匹配。

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

以下是您可以循环调用文件编号以检索公司状态的功能

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的限制，所以我认为在开始时将所有文件号存储在字典中，然后在请求期间稍后进行更新都没问题。您甚至可以拥有多个存放文件号范围的字典，例如上等的旧百科全书的数量。例如，这会将循环限制为您希望从同一请求中填充的字典。值得探索的地方。

从HTML元素中提取数据-VBA

1 个答案: