如何通过VBA实现Edge网页文本自动复制到Excel？

方案1：直接通过HTTP请求获取API内容（推荐） #

你无需打开浏览器就能获取谷歌地图API返回的JSON文本，用VBA的MSXML2.XMLHTTP对象直接发送请求即可，这比打开浏览器再复制高效且稳定得多。

代码示例：

Sub GetGoogleMapsAPI()
    Dim xmlHttp As Object
    Dim responseText As String
    Dim apiUrl As String
    
    ' 替换为你的API Key
    apiUrl = "https://maps.googleapis.com/maps/api/directions/json?origin=Disneyland&destination=Universal+Studios+HOllywood&key=your_API_Key"
    
    ' 创建XMLHTTP对象
    Set xmlHttp = CreateObject("MSXML2.XMLHTTP")
    xmlHttp.Open "GET", apiUrl, False
    xmlHttp.send
    
    ' 获取返回的文本内容
    responseText = xmlHttp.responseText
    
    ' 将内容写入Sheet1的A1单元格
    Worksheets("Sheet1").Range("A1").Value = responseText
    
    ' 释放对象
    Set xmlHttp = Nothing
End Sub

方案2：模拟键盘操作复制Edge页面内容（仅当必须打开浏览器时使用） #

如果必须打开Edge浏览器并复制内容，可以用SendKeys模拟全选和复制的键盘快捷键，但这种方法依赖窗口焦点，稳定性稍差，需确保Edge窗口处于激活状态。

代码示例：

Sub LOADEdgeAndCopy()
    Dim objShell As Object
    Dim waitTime As Integer
    
    Set objShell = CreateObject("Shell.Application")
    ' 打开Edge加载指定页面
    objShell.ShellExecute "microsoft-edge:https://maps.googleapis.com/maps/api/directions/json?origin=Disneyland&destination=Universal+Studios+HOllywood&key=your_API_Key"
    
    ' 等待页面加载，根据网络情况调整等待时间（单位：秒）
    waitTime = 10
    Application.Wait Now + TimeValue("00:00:" & waitTime)
    
    ' 激活Edge窗口（需根据实际页面的窗口标题调整，示例为"Google Maps"）
    AppActivate "Google Maps"
    
    ' 模拟全选（Ctrl+A）和复制（Ctrl+C）
    SendKeys "^a", True
    SendKeys "^c", True
    
    ' 等待复制完成
    Application.Wait Now + TimeValue("00:00:01")
    
    ' 粘贴到Sheet1的A1单元格
    Worksheets("Sheet1").Range("A1").PasteSpecial xlPasteValues
    
    Set objShell = Nothing
End Sub

注意事项： #

• 方案2中AppActivate的窗口标题需要根据实际Edge窗口的标题调整，你可以先打开页面查看窗口标题后替换示例内容。
• 等待时间需根据你的网络速度调整，确保页面完全加载后再执行复制操作。
• SendKeys对系统环境敏感，若有其他窗口抢占焦点，可能导致操作失败。

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