VBA运行报错-2147023179(800706b5)接口未知问题咨询

错误码-2147023179 (800706b5)属于COM接口调用异常，对应你的代码有三个明确的触发点：

• InternetExplorerMedium对象退出后COM接口未完全释放，后续操作网络路径时调用了已失效的接口
• HTTP路径转WebDAV路径逻辑无校验，转换后的路径无效时Workbooks.Open调用会触发自动化接口错误
• 工作簿打开逻辑依赖ActiveWorkbook，网络文件打开延迟时会绑定到未初始化的对象，引发接口调用失败

1. 修复IE对象释放逻辑 #

在IE.Quit后增加等待逻辑，确保COM接口完全释放，64位Office需在API声明中加PtrSafe关键字：

' 模块顶部增加等待API声明
Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

' 原有IE处理部分修改为：
Dim IE As InternetExplorerMedium
Set IE = New InternetExplorerMedium
IE.Visible = False
IE.Navigate source
Do While IE.ReadyState <> 4 Or IE.Busy
    DoEvents
Loop
IE.Quit
Sleep 1000 ' 等待1秒确保IE进程退出、接口释放
Set IE = Nothing
Sleep 500

2. 增加路径有效性校验 #

转换完WebDAV路径后先判断路径是否存在，避免后续无效调用：

source = source & "\measure_files\"
' 新增路径校验逻辑
If Dir(source, vbDirectory) = "" Then
    MsgBox "目标路径不存在：" & source, vbCritical
    Exit Sub
End If
strFile = Dir(source)

3. 修正工作簿绑定逻辑 #

直接捕获Workbooks.Open的返回值，避免依赖ActiveWorkbook，同时增加错误捕获跳过损坏/无权限文件：

Do While Len(strFile) > 0
    On Error Resume Next ' 打开失败时跳过当前文件
    Set wb_from = Workbooks.Open(Filename:=source & strFile, ReadOnly:=True)
    On Error GoTo 0
    If Not wb_from Is Nothing Then
        Call copy_sheets(ws_the_tool, wb_from)
        wb_from.Close savechanges:=False
        Set wb_from = Nothing
    End If
    strFile = Dir()
Loop

4. 前置依赖检查 #

• 打开VBA编辑器→工具→引用，勾选「Microsoft Internet Controls」和「Microsoft HTML Object Library」
• 确认当前Windows账号对目标WebDAV路径有可读权限，无权限时需先在资源管理器中挂载一次WebDAV目录完成身份验证

Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Sub copy_sheet_from_folder(ws_the_tool As Workbook)

    Dim source As String
    Dim strFile As String
    Dim wb_from As Workbook
    
    source = ws_the_tool.Path
    
    If InStr(1, source, "http") Then

        Dim IE As InternetExplorerMedium
        Set IE = New InternetExplorerMedium
        IE.Visible = False
        IE.Navigate source
        Do While IE.ReadyState <> 4 Or IE.Busy
            DoEvents
        Loop
        IE.Quit
        Sleep 1000
        Set IE = Nothing
        Sleep 500
        
        Dim bIsSSL As Boolean
        bIsSSL = InStr(1, source, "https:") > 0
        
        source = Replace(Replace(source, "/", "\"), "%20", " ")
        source = Replace(Replace(source, "https:", vbNullString), "http:", vbNullString)
        source = Replace(source, Split(source, "\")(2), Split(source, "\")(2) & "@SSL\DavWWWRoot")
        
        If Not bIsSSL Then source = Replace(source, "@SSL\", vbNullString)
        
    End If
    
    source = source & "\measure_files\"
    If Dir(source, vbDirectory) = "" Then
        MsgBox "目标路径不存在：" & source, vbCritical
        Exit Sub
    End If
    strFile = Dir(source)
    
    Do While Len(strFile) > 0
        On Error Resume Next
        Set wb_from = Workbooks.Open(Filename:=source & strFile, ReadOnly:=True)
        On Error GoTo 0
        If Not wb_from Is Nothing Then
            Call copy_sheets(ws_the_tool, wb_from)
            wb_from.Close savechanges:=False
            Set wb_from = Nothing
        End If
        strFile = Dir()
    Loop
    
End Sub

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