求助：如何用Excel VBA抓取网页动态内容？

方案一：原生VBA获取晚加载的动态内容 #

原生GET请求仅能获取网页初始HTML，动态插入的内容通常由AJAX/Fetch请求从后端接口加载，可按以下步骤实现：

1. 抓包定位动态内容接口
   打开浏览器开发者工具（F12）→ 切换到「网络」面板，刷新网页后筛选「XHR/Fetch」类型请求，找到返回目标内容的接口，记录：

   • 请求URL
   • 请求方法（GET/POST）
   • 必要请求头（如User-Agent、Referer等）
   • 请求参数（POST请求需记录）

2. VBA直接请求接口
   修改原有代码，直接调用目标接口而非整个网页，示例代码：

   Dim http As Object
   Dim responseText As String
   Set http = CreateObject("MSXML2.XMLHTTP.6.0")
   
   ' 替换为抓包得到的接口URL
   Dim apiUrl As String
   apiUrl = "https://example.com/api/target-data"
   
   http.Open "GET", apiUrl, False
   ' 添加抓包得到的请求头
   http.setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 10.0; Win64; x64; rv:134.0) Gecko/20100101 Firefox/134.0"
   http.setRequestHeader "Referer", "https://example.com/target-page" ' 按需添加
   http.Send
   
   If http.Status = 200 Then
       responseText = http.responseText
       ' 解析响应内容
       ParseDynamicContent responseText
   Else
       MsgBox "请求失败，状态码：" & http.Status
   End If
   Set http = Nothing
   

3. 解析接口响应
   若接口返回JSON格式，可通过ScriptControl解析（需启用宏并允许脚本执行）：

   Sub ParseDynamicContent(jsonText As String)
       Dim sc As Object
       Set sc = CreateObject("MSScriptControl.ScriptControl")
       sc.Language = "JScript"
       
       ' 解析JSON并提取数据
       Dim jsonObj As Object
       Set jsonObj = sc.Eval("(" & jsonText & ")")
       
       ' 示例：提取目标字段并写入Excel
       Dim targetContent As String
       targetContent = jsonObj.targetField ' 替换为实际字段名
       ThisWorkbook.Sheets("监控表").Range("A1").Value = targetContent
       
       Set sc = Nothing
       Set jsonObj = Nothing
   End Sub
   

   若返回XML，使用MSXML2.DOMDocument解析即可。

方案二：修改Edge自动化代码替换Dictionary类型 #

原Codeproject代码中VB.Net的Dictionary(Of String, String)可替换为VBA支持的Scripting.Dictionary，调整步骤如下：

1. 替换Dictionary声明
   原VB.Net代码：

   Dim dict As New Dictionary(Of String, String)
   

   修改为VBA后期绑定代码（无需额外引用）：

   Dim dict As Object
   Set dict = CreateObject("Scripting.Dictionary")
   

2. 适配Dictionary方法调用
   VBA的Scripting.Dictionary方法与VB.Net略有差异，调整如下：

   • 添加键值对：dict.Add "key", "value"（VBA不允许重复键）
   • 获取值：dict("key") 或 dict.Item("key")
   • 判断键是否存在：dict.Exists("key")

3. 其他VB.Net语法转VBA

   • String.Empty 替换为 ""
   • 对象释放统一用Set obj = Nothing
   • 移除VB.Net特有的语法（如Option Strict On）

修改后的核心代码示例：

' 初始化Edge启动参数字典
Dim edgeArgs As Object
Set edgeArgs = CreateObject("Scripting.Dictionary")
edgeArgs.Add "--no-first-run", ""
edgeArgs.Add "--no-default-browser-check", ""
' 添加其他所需启动参数

' 启动Edge进程
Dim shell As Object
Set shell = CreateObject("WScript.Shell")
Dim edgePath As String
edgePath = "C:\Program Files (x86)\Microsoft\Edge\Application\msedge.exe"
shell.Run edgePath & " " & Join(edgeArgs.Keys, " "), 1, False
Set shell = Nothing
Set edgeArgs = Nothing

内容的提问来源于stack exchange，提问作者Big_Al_Tx