从Firefox复制数据到Excel的VBA宏报错问题求助

你的宏在执行ActiveSheet.PasteSpecial时触发1004错误，核心原因是剪贴板中没有有效的HTML内容，加上SendKeys模拟操作的不可靠性（比如Firefox未激活、等待时间不足导致复制失败）。以下是具体修复方案：

一、先解决剪贴板有效性问题 #

1. 确保Firefox成为活动窗口 #

SendKeys只会作用于当前前台窗口，你用vbHide启动Firefox会导致窗口在后台，复制操作根本没在Firefox里执行。修改启动代码：

' 去掉vbHide，让Firefox前台显示
Shell """" & pathFireFox & """" & " -new-tab " & url, vbNormalFocus
' 等待窗口加载
Application.Wait Time + TimeSerial(0, 0, 7)
' 强制激活Firefox窗口（需添加API声明）

在模块顶部添加API声明：

Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
Declare PtrSafe Function SetForegroundWindow Lib "user32" (ByVal hWnd As LongPtr) As LongPtr

然后在Application.Wait后添加激活代码：

Dim ffWindow As LongPtr
ffWindow = FindWindow("MozillaWindowClass", vbNullString)
If ffWindow <> 0 Then
    SetForegroundWindow ffWindow
End If

2. 延长等待时间或检查复制结果 #

SendKeys的等待时间可能不够，尤其是网页加载慢的情况。可以延长等待时间，或者在复制后检查剪贴板内容（需引用Microsoft Forms 2.0 Object Library）：

Dim dataObj As New DataObject
dataObj.GetFromClipboard
If dataObj.GetFormat(1) = False Then ' 1代表文本格式，也可检查HTML格式
    MsgBox "复制失败，跳过当前网页"
    Exit Sub
End If

二、修正PasteSpecial调用方式 #

不要依赖ActiveSheet和选中的单元格，直接指定目标范围：

' 替换原来的Cells(1, h).Select和ActiveSheet.PasteSpecial...
Sheets("Arkusz2").Cells(1, h).PasteSpecial Format:="HTML", Link:=False, DisplayAsIcon:=False, NoHTMLFormatting:=True

三、推荐：改用XMLHTTP直接获取网页内容（彻底避免SendKeys问题） #

SendKeys是最不可靠的模拟方式，直接用VBA的XMLHTTP获取网页HTML再导入Excel，稳定性和效率都高很多：

Sub GetWebContentDirectly(url As String)
    Dim xmlHttp As Object
    Dim htmlDoc As Object
    Dim targetCell As Range
    
    Set xmlHttp = CreateObject("MSXML2.XMLHTTP.6.0")
    xmlHttp.Open "GET", url, False
    xmlHttp.send
    
    If xmlHttp.Status = 200 Then
        Set htmlDoc = CreateObject("HTMLFile")
        htmlDoc.body.innerHTML = xmlHttp.responseText
        
        ' 获取目标单元格
        With Sheets("Arkusz2")
            Set targetCell = .Cells(1, .Cells(3, .Columns.Count).End(xlToLeft).Column + 1)
        End With
        
        ' 将HTML内容粘贴到目标单元格
        targetCell.PasteSpecial Format:="HTML", Link:=False, DisplayAsIcon:=False, NoHTMLFormatting:=True
    Else
        MsgBox "网页加载失败，状态码：" & xmlHttp.Status
    End If
    
    Set xmlHttp = Nothing
    Set htmlDoc = Nothing
End Sub

修改StartII里的调用，把Call OpenInFireFoxNewTab(Cells(i, 6).Value)换成Call GetWebContentDirectly(Cells(i, 6).Value)即可。

额外注意事项 #

• 确保Excel启用宏，并且信任对VBA项目对象模型的访问（Excel选项-信任中心-信任中心设置-宏设置里开启）
• 如果网页需要登录或有反爬机制，XMLHTTP方式可能需要添加请求头或处理Cookie，此时可考虑用Selenium等浏览器自动化工具

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