Excel 从网站列表中删除数据

`我正在努力搜集数据，比如

成立日期、电子邮件地址、地址和董事详细信息 从500个网站的列表中可以扩展到许多页面。我需要提取网站，这是我在excel中使用Power query完成的，但在Power query中提取每个网站的具体细节是一项繁琐的工作

此外，问题在于电子邮件地址和地址，无法找到类/标记ID名称。（这是我最近得到的，但现在我需要大量网站的帮助，代码应该适用于所有网站（因为它们在特定位置具有相同类型的数据）

Sub GetInfo()
    Const URL = "https://www.zaubacorp.com/company/TECHDRIVE-SOFTWARE-LIMITED/U30007DL1999PLC356280"
    Dim Html As New HTMLDocument
    Dim elem As Object, adr As Object

    With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", URL, False
        .send
        Html.body.innerHTML = .responseText
    End With

    For Each elem In Html.getElementsByTagName("b")
        If InStr(elem.innerText, "Email ID:") > 0 Then
            [A2] = elem.ParentNode.innerText
            Exit For
        End If
    Next elem

    For Each adr In Html.getElementsByTagName("b")
        If InStr(adr.innerText, "Address:") > 0 Then
            [B2] = adr.ParentNode.NextSibling.innerText
            Exit For
        End If
    Next adr
End Sub

---

我已经修改了您现有的脚本以遍历多个页面，现在可以从中提取每个容器的

名称

，

成立日期

，

电子邮件

和

地址

。请确保在执行下面的脚本之前创建一个名为

数据容器

的工作表

Sub GetInfo()
    Const prefix$ = "https://www.zaubacorp.com/company-list/nic-300/p-"
    Const suffix$ = "-company.html"
    Dim Html As New HTMLDocument, Htmldoc As New HTMLDocument
    Dim newHtml As New HTMLDocument, newUrl$, elem As Object, oDate As Object, R&, I&
    Dim Wb As Workbook, ws As Worksheet, adr As Object, P&, pageNum&

    Set Wb = ThisWorkbook
    Set ws = Wb.Worksheets("DataContainer") '----------->create a sheet and name it `DataContainer` in order for the script to write the results in there

    For pageNum = 1 To 2  '---------------------------------> this is where you put the highest number the script will traverse
        With CreateObject("MSXML2.XMLHTTP")
            .Open "GET", prefix & pageNum & suffix, False
            .send
            Html.body.innerHTML = .responseText
        End With

        With Html.querySelectorAll("#table tbody tr")
            For I = 0 To .Length - 1
                Htmldoc.body.innerHTML = .item(I).outerHTML
                newUrl = Htmldoc.querySelector("a[href]").getAttribute("href")

                With CreateObject("MSXML2.XMLHTTP")
                    .Open "GET", newUrl, False
                    .send
                    newHtml.body.innerHTML = .responseText
                End With

                R = R + 1: ws.Cells(R, 1) = newHtml.querySelector(".container > h1").innerText

                For Each oDate In newHtml.getElementsByTagName("p")
                    If InStr(oDate.innerText, "Date of Incorporation") > 0 Then
                        ws.Cells(R, 2) = oDate.ParentNode.NextSibling.innerText
                        Exit For
                    End If
                Next oDate

                For Each elem In newHtml.getElementsByTagName("b")
                    If InStr(elem.innerText, "Email ID:") > 0 Then
                        ws.Cells(R, 3) = elem.ParentNode.innerText
                        Exit For
                    End If
                Next elem

                For Each adr In newHtml.getElementsByTagName("b")
                    If InStr(adr.innerText, "Address:") > 0 Then
                        ws.Cells(R, 4) = adr.ParentNode.NextSibling.innerText
                        Exit For
                    End If
                Next adr
            Next I
        End With
    Next pageNum
End Sub

---

Set webpage=ie.document Set mtbl=webpage.getElementsByTagName（“表格”）（1）Set Table_data=mtbl.getElementsByTagName（“tr”）我为wikipedia编写的这段简单代码用于提取数据，但对于tabove特定网站，它不起作用，而且我有500多个网站分布在多个页面上。请在任何建议之前查看该网站。请不要在评论中发布代码！评论中的代码不可读，在大多数情况下没有用处，因为换行符不可见，但它们在VBA中非常重要。相反，将属于您的问题的所有内容都放在原始问题部分。您可以将其放在您的代码或附加信息中。@SIM正如我前面解释的，我无法投票表决您的答案，先生。问题已结束。我再次道歉。@Pᴇʜ完成了，先生，我已经附上了我最初的小代码。好吧，你不能发布3行代码，然后等待我们完成你的整个项目（这不是一个免费的代码编写服务）。你甚至没有告诉我们代码有什么问题。你对代码有什么问题？太棒了，先生，我会修改代码以获得“注册日期”。感谢您宝贵的时间和帮助。再次为过去的错误道歉。无法从检查工具中提取“公司成立日期”值。您好，先生，我无法提取“公司成立日期”和“活动”现在从列表中删除。你能帮我吗？好的，我已经修改了脚本，加入了

成立日期

@Amit Shah。谢谢。非常感谢，我已经调整了代码，以便获得更多信息。