使用 Web class=\"search-item-header\" 抓取企业名称

Answer 1

如果你使用 UserAgent，你可以用 xhr 做你想做的事。这是每行所有数据集的代码，其中包含您发布的网址的所有页面的当前字段。

Sub TutorailsPoint()
  Dim doc As Object
  Dim url As String
  Dim page As Long
  Dim hits As Long
  Dim maxPage As Long
  Dim maxPageKnown As Boolean
  Dim currRow As Long
  Dim nodeAllGroups As Object
  Dim nodeOneGroup As Object
  Dim nodeContactData As Object
  Dim nodeWebSite As Object
  Dim telephone As Boolean
  
  page = 1
  maxPage = 1
  currRow = 2
  Set doc = CreateObject("htmlFile")
  With CreateObject("MSXML2.ServerXMLHTTP.6.0")
    'Call all pages
    Do
      url = "https://www.thoroughexamination.org/postcode-search/nationwide?page=" & page
      .Open "GET", url, False
      .setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 10.0; Win64; x64; rv:91.0) Gecko/20100101 Firefox/91.0"
      .send
      
      If .Status = 200 Then
        doc.body.innerHTML = .responseText
        
        'How many pages to call
        If Not maxPageKnown Then
          hits = CLng(doc.getElementsByClassName("summary")(0).getElementsByTagName("b")(1).innertext)
          maxPage = hits / 20
          If hits Mod 20 <> 0 Then
            maxPage = maxPage + 1
          End If
          maxPageKnown = True
          'Debug.Print maxPage
        End If
        
        Set nodeAllGroups = doc.getElementsByClassName("group")
        For Each nodeOneGroup In nodeAllGroups
          'Business name
          Cells(currRow, 1) = nodeOneGroup.getElementsByTagName("h2")(0).innertext
          'Address
          Cells(currRow, 2) = nodeOneGroup.getElementsByTagName("p")(0).innertext
          
          'Contact block
          Set nodeContactData = nodeOneGroup.getElementsByClassName("depot")
          If nodeContactData.Length <> 0 Then
            'Telephone
            If InStr(1, nodeContactData(0).innertext, "tel:") > 0 Then
              Cells(currRow, 3).NumberFormat = "@"
              Cells(currRow, 3) = Trim(nodeContactData(0).getElementsByTagName("strong")(0).innertext)
              telephone = True
            End If
            
            'Fax
            If InStr(1, nodeContactData(0).innertext, "fax:") > 0 Then
              Cells(currRow, 4).NumberFormat = "@"
              If telephone Then
                Cells(currRow, 4) = Trim(Replace(nodeContactData(0).getElementsByTagName("p")(0).FirstChild.NextSibling.NextSibling.NextSibling.NodeValue, "fax:", ""))
              Else
                Cells(currRow, 4) = Trim(Replace(nodeContactData(0).getElementsByTagName("p")(0).FirstChild.NodeValue, "fax:", "")) 'not sure, not seen no telephone
              End If
            End If
            
            'Email
            If InStr(1, nodeContactData(0).innertext, "email:") > 0 Then
              Cells(currRow, 5) = Trim(nodeContactData(0).getElementsByTagName("a")(0).innertext)
            End If
            
            'website
            Set nodeWebSite = nodeContactData(0).getElementsByClassName("website")
            If nodeWebSite.Length > 0 Then
              Cells(currRow, 6) = Trim(nodeWebSite(0).innertext)
            End If
          End If
          
          telephone = False
          currRow = currRow + 1
        Next nodeOneGroup
        
        page = page + 1
      Else
        Cells(currRow, 1) = "Page not loaded. HTTP status " & .Status
        Cells(currRow, 2) = url
        currRow = currRow + 1
      End If
    Loop While page <= maxPage
  End With
End Sub

Answer 2

Internet Explorer 已被 MS 删除，因此使用它不是一个好主意。从现在开始，在 VBA 中，我最好的选择是使用 Selenium（Selenium 类型库）来抓取 WWW。要以正确的方式开始使用 Selenium，您必须注意以下事项：

1. 更新相关的 .Net 框架

2. 安装Selenium Basic 应用

3. 下载安装Chromedriver.exe版本（查看最新版本here）与谷歌浏览器版本完全兼容（本机必须安装）。提取“Chromedriver.exe”并将其放在安装 Selenium Basic 的同一文件夹中（我在这里安装了 Selenium Basic：“C:\Program Files\SeleniumBasic”）

4. 将 VBE 中的引用添加到 ActiveX 库：'Selenium Type Library'

   将代码放在 VBE 上的标准模块中：

   Sub fnGetDataFromWWW()
       Dim oWD As WebDriver
       Dim post As Selenium.WebElement
       Dim groups As Selenium.WebElements
       Dim strText As String
       Dim intItem As Integer
   
       Set oWD = New Selenium.WebDriver
       oWD.Start "chrome"
       DoEvents
       oWD.Get "https://www.thoroughexamination.org/postcode-search/nationwide?page=1"
       DoEvents
   
       Set groups = oWD.FindElementsByClass("group")
       
       For Each post In groups
           strText = post.Attribute("outerText")
           For intItem = 0 To UBound(Split(strText, Chr(10)))
               If Trim(Split(strText, Chr(10))(intItem)) <> "" Then
                   Debug.Print Split(strText, Chr(10))(intItem)
               End If
           Next
       Next post
   
   End Sub