excel - 如果使用电话号码,谷歌通过 VBA 搜索没有结果
问题描述
使用我在网上找到的以下代码,它在搜索电话号码时不返回结果,文本很好,带回网络链接和标题
我注意到,当搜索号码时,link.className 中没有 className“r”,我将如何修复与电话号码一起使用
Sub XMLHTTP()
Dim url As String, lastRow As Long, i As Long
Dim XMLHTTP As Object, html As Object, objResultDiv As Object, objH3 As Object, link As Object
lastRow = Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To lastRow
url = "https://www.google.co.uk/search?q=03701116565" & "&rnd=" & WorksheetFunction.RandBetween(1, 10000)
Set XMLHTTP = CreateObject("MSXML2.serverXMLHTTP")
XMLHTTP.Open "GET", url, False
XMLHTTP.setRequestHeader "Content-Type", "text/xml"
XMLHTTP.setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 6.1; rv:25.0) Gecko/20100101 Firefox/25.0"
XMLHTTP.send
Set html = CreateObject("htmlfile")
html.body.innerHTML = XMLHTTP.ResponseText
Set objResultDiv = html.getelementbyid("rso")
Set objH3 = objResultDiv.getelementsbytagname("h3")
For Each link In objH3
If link.className = "r" Then
Cells(i, 2) = link.innerText
Cells(i, 3) = link.getelementsbytagname("a")(0).href
DoEvents
End If
Next
Next
End Sub
解决方案
有一个类名r
。请注意以下事项:
Option Explicit
Public Sub GetLinks()
Dim html As HTMLDocument, links As Object, i As Long, counter As Long
Set html = New HTMLDocument
With CreateObject("MSXML2.XMLHTTP")
.Open "GET", "https://www.google.co.uk/search?q=03701116565", False
.send
html.body.innerHTML = StrConv(.responseBody, vbUnicode)
End With
With html
Set links = .querySelectorAll(".r > [href] , .r h3")
End With
For i = 0 To links.Length - 1 Step 2
counter = counter + 1
ActiveSheet.Cells(counter, 1) = links.item(i)
ActiveSheet.Cells(counter, 2) = links.item(i + 1).innerText
Next
End Sub
实际与您按类定位的标题标签元素之前的href
子标签相关联。是标签父级的类。a
h3
r
a
如果您想使用后期绑定以及与您类似的方法,则可以使用效率较低的以下方法。请注意,父 div 元素已被选中,因此可以访问a
标签并且h3
可以用于限定类。
Option Explicit
Public Sub GetLinks()
Dim html As Object, i As Long
Dim objResultDiv As Object, objH3 As Object, link As Object
Set html = CreateObject("htmlfile")
With CreateObject("MSXML2.XMLHTTP")
.Open "GET", "https://www.google.co.uk/search?q=03701116565", False
.send
html.body.innerHTML = .responseText
End With
Set objResultDiv = html.getElementById("rso")
Set objH3 = objResultDiv.getElementsByTagName("div")
For Each link In objH3
If link.className = "r" Then
i = i + 1
On Error Resume Next
ActiveSheet.Cells(i, 2) = link.getElementsByTagName("a")(0).href
ActiveSheet.Cells(i, 3) = link.getElementsByTagName("h3")(0).innerText
On Error GoTo 0
End If
Next
End Sub
推荐阅读
- python - max() 只检查列表/元组中的第一个值是否有多个列表/元组?
- android - 我们可以在任何 UI 组件背景中添加进度条吗?
- xml - 使用 Exist-db 的 xquery 将节点从一个 xml 文件插入另一个
- ms-access-2010 - 需要帮助设置 Access 查询
- c# - 如何计算 C# 中给定数据集的移动平均值?
- laravel - InvalidArgumentException:无法找到名称为 [default] 的工厂 - laravel、faker、phpunit
- c# - 尝试向用户列表发送电子邮件
- sql - 寻找作为 Oracle SQL 数据库前端的工具(GUI 或表单)
- vega - 按 Vega Lite 中的另一个字段对轴进行排序
- javascript - Jquery .each() 呈现 [object HTMLUListElement] 而不是 HTML