You need to enable JavaScript to run this app.
优惠活动
大模型
产品
解决方案
定价
更多
文档控制台
免费开始使用

VBA网页滚动定位与Excel数据抓取故障排查求助

排查你的Google Maps数据抓取VBA代码问题

我来帮你一步步拆解代码里的问题,以及对应的解决思路:

一、变量声明的不规范问题

你的代码里很多变量没有明确声明类型,这会导致隐式Variant类型,容易引发意外错误:

  • Dim Re, Cr, cipherDict As Object:只有cipherDictObject类型,ReCr是默认的Variant,应该改成:
    Dim Re As Object, Cr As Object, cipherDict As Object
    
  • URLstitlephonewebSite这些变量都没有提前声明,建议在代码开头加上Option Explicit强制变量声明,这样能提前发现未声明的变量错误。

二、HTML选择器的语法错误

你用的选择器没有遵循CSS选择器规则,导致无法找到目标元素:

  • section-hero-header-title-title是类名,在querySelector里必须加.前缀,正确写法是:
    title = .querySelector(".section-hero-header-title-title").innerText
    
  • 另外,Google Maps的页面结构经常更新,[data-item-id^=phone] [jsan*=text]这类依赖jsan属性的选择器非常不稳定,很容易失效。建议改用更通用的属性选择器,比如:
    ' 抓取电话号码
    phone = .querySelector("[data-tooltip='Copy phone number']").innerText
    ' 抓取网站链接
    webSite = .querySelector("[aria-label^='Website']").getAttribute("href")
    

三、静态HTML无法获取动态渲染内容的核心问题

这是最关键的问题:你用MSXML2.XMLHTTP获取的是页面的静态HTML源码,但Google Maps的大部分内容(比如电话、网站、营业时间等)是通过JavaScript动态加载的,静态源码里根本没有这些元素,所以你用html.body.innerHTML加载后自然找不到对应的节点,会触发“对象变量或With块变量未设置”的错误。

解决这个问题的两种思路:

  1. 改用IE浏览器控件(或Selenium):通过模拟浏览器加载页面,等待JavaScript渲染完成后再抓取数据。示例代码如下:
    Dim ie As Object
    Set ie = CreateObject("InternetExplorer.Application")
    ie.Visible = True ' 可以设为False隐藏浏览器
    ie.Navigate URL
    ' 等待页面加载完成
    Do While ie.Busy Or ie.ReadyState <> 4
        DoEvents
    Loop
    ' 等待动态内容渲染(加个延时确保内容加载完成)
    Application.Wait Now + TimeValue("00:00:03")
    ' 获取渲染后的HTML文档
    Set html = ie.Document
    ' 后续选择器操作即可拿到动态内容
    title = html.querySelector(".section-hero-header-title-title").innerText
    ' ...其他代码
    ie.Quit
    Set ie = Nothing
    
  2. 分析Google Maps的API接口:通过浏览器开发者工具抓包,找到加载数据的API接口,直接请求接口获取JSON数据,这种方式效率更高,但需要处理接口的认证和反爬机制。

四、编码处理和冗余代码问题

  • 你同时用了StrConv(.responseBody, vbUnicode).responseText,其实responseText已经自动处理了编码,不需要再用StrConv转换,而且如果页面是UTF-8编码,StrConv可能会导致乱码。建议直接用:
    sResponse = Cr.responseText
    
  • 代码里声明了RecipherDict等对象但没有使用,属于冗余代码,可以删除。

五、错误处理的问题

你注释掉了On Error Resume Next,这虽然能掩盖错误,但会让你无法定位问题所在。建议去掉这个注释,或者添加合理的错误处理分支:

On Error GoTo ErrorHandler
' 你的代码逻辑...

Exit Sub
ErrorHandler:
MsgBox "错误编号:" & Err.Number & vbCrLf & "错误描述:" & Err.Description, vbExclamation
' 清理对象
Set Cr = Nothing
Set html = Nothing

最后,修改后的完整代码示例(基于IE控件):

Option Explicit

Public Sub GData()
    Dim ie As Object
    Dim html As HTMLDocument
    Dim URL As String, title As String, phone As String, webSite As String
    Dim datarw As Long
    
    URL = "https://www.google.com/maps/place/Silky+Beauty+Salon/@22.2932632,70.7723656,17z/data=!3m1!4b1!4m5!3m4!1s0x3959ca1278f4820b:0x44e998d30e14a58c!8m2!3d22.2932632!4d70.7745543"
    
    ' 初始化IE浏览器
    Set ie = CreateObject("InternetExplorer.Application")
    ie.Visible = True
    ie.Navigate URL
    
    ' 等待页面加载完成
    Do While ie.Busy Or ie.ReadyState <> 4
        DoEvents
    Loop
    ' 等待动态内容渲染
    Application.Wait Now + TimeValue("00:00:03")
    
    ' 获取HTML文档
    Set html = ie.Document
    
    ' 抓取数据(注意选择器可能需要根据页面更新调整)
    On Error Resume Next ' 临时处理元素找不到的情况
    title = html.querySelector(".section-hero-header-title-title").innerText
    phone = html.querySelector("[data-tooltip='Copy phone number']").innerText
    webSite = html.querySelector("[aria-label^='Website']").getAttribute("href")
    On Error GoTo 0
    
    ' 写入Excel
    datarw = ActiveSheet.Cells(ActiveSheet.Rows.Count, "A").End(xlUp).Row + 1
    ActiveSheet.Cells(datarw, 1).Value = title
    ActiveSheet.Cells(datarw, 5).Value = phone
    ActiveSheet.Cells(datarw, 7).Value = webSite
    ActiveSheet.Rows(datarw).WrapText = False
    
    ' 清理资源
    ie.Quit
    Set ie = Nothing
    Set html = Nothing
End Sub

注意:Google Maps的页面结构会随时更新,上述选择器可能在未来失效,需要你根据实际页面结构调整。另外,频繁抓取Google Maps数据可能违反其服务条款,建议谨慎操作。

内容的提问来源于stack exchange,提问作者Lalit Patel

火山引擎 最新活动