连接Jedox服务器的Excel运行宏后原工作簿崩溃问题求助

你的宏在处理常规xlsx文件时功能正常，但遇到连接Jedox服务器的文件时原工作簿崩溃，核心原因大概率是Jedox连接文件在打开、修改、保存过程中残留未释放的COM资源，或自动触发的连接操作干扰了Excel进程，加上原代码缺少错误处理，导致异常时无法正确重置环境状态。

针对性修复措施 #

1. 禁用连接自动刷新 #

打开Jedox文件时，通过参数避免自动刷新连接，减少进程干扰：

Set wbNew = Workbooks.Open(Filename:=myPath & myFile, UpdateLinks:=xlUpdateLinksNever)

2. 增加错误处理与资源释放 #

确保无论是否发生异常，都能重置Application设置、释放对象，避免内存泄漏：

• 在循环内添加错误捕获，防止单个文件处理失败导致整个宏中断
• 显式销毁wbNew对象，避免残留引用

3. 优化SaveAs与Close逻辑 #

SaveAs已完成保存，Close时无需再设置SaveChanges:=True，避免重复触发保存操作：

wbNew.Close SaveChanges:=False

4. 可选：手动断开Jedox连接 #

如果崩溃仍存在，可在保存前手动断开Jedox连接，避免连接状态残留：

Dim conn As WorkbookConnection
For Each conn In wbNew.Connections
    If InStr(1, conn.Name, "Jedox", vbTextCompare) > 0 Then
        conn.OLEDBConnection.Disconnect
    End If
Next conn

修改后的完整代码 #

Function GetUNCLateBound(ByVal strMappedDrive As String) As String
    Dim objFso As Object
    Set objFso = CreateObject("Scripting.FileSystemObject")

    Dim strDrive As String
    Dim strShare As String

    strDrive = objFso.GetDriveName(strMappedDrive)
    strShare = objFso.Drives(strDrive & "\").ShareName
    GetUNCLateBound = Replace(strMappedDrive, strDrive, strShare)

    Set objFso = Nothing
End Function

Sub UpdateConnection()
    Dim wb As Workbook
    Dim wbNew As Workbook
    Dim vDevConName As Range
    Dim vProdConName As Range
    Dim vProdFolder As Range
    Dim vDevFolder As Range
    Dim vWBFromPath As String
    Dim vWBToPath As String
    Dim myPath As String
    Dim myFile As String
    Dim myExtension As String

    ' 初始化环境优化设置
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.DisplayAlerts = False

    Set wb = ThisWorkbook

    ' 读取命名区域参数
    Set vDevConName = wb.Names("rngDevConnection").RefersToRange
    Set vProdConName = wb.Names("rngProdConnection").RefersToRange
    Set vDevFolder = wb.Names("rngDevFolder").RefersToRange
    Set vProdFolder = wb.Names("rngProdFolder").RefersToRange

    ' 构建目标路径并创建文件夹
    vWBToPath = GetUNCLateBound(wb.Path) & "\" & vProdFolder & "\"
    If Dir(vWBToPath, vbDirectory) = "" Then
        MkDir vWBToPath
    End If

    vWBFromPath = GetUNCLateBound(wb.Path) & "\" & vDevFolder & "\"
    myPath = vWBFromPath
    If myPath = "" Then GoTo ResetSettings

    myExtension = "*.xls*"
    myFile = Dir(myPath & myExtension)

    Do While myFile <> ""
        On Error Resume Next
        ' 打开文件时禁用链接更新，避免Jedox自动刷新
        Set wbNew = Workbooks.Open(Filename:=myPath & myFile, UpdateLinks:=xlUpdateLinksNever)
        On Error GoTo 0

        If Not wbNew Is Nothing Then
            DoEvents
            ' 修改参数单元格
            With wbNew.Sheets("Params").Range("B2")
                .Value = vProdConName.Value
                .Calculate
            End With

            ' 可选：断开Jedox连接（崩溃未解决时启用）
            ' Dim conn As WorkbookConnection
            ' For Each conn In wbNew.Connections
            '     If InStr(1, conn.Name, "Jedox", vbTextCompare) > 0 Then
            '         conn.OLEDBConnection.Disconnect
            '     End If
            ' Next conn

            ' 保存并关闭文件
            wbNew.SaveAs Filename:=vWBToPath & myFile, FileFormat:=51
            wbNew.Close SaveChanges:=False
            DoEvents
            ' 显式释放对象
            Set wbNew = Nothing
        End If

        myFile = Dir
    Loop

    wb.Activate
    MsgBox "Task Complete!"

ResetSettings:
    ' 强制重置所有环境设置
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    ' 确保异常时未关闭的文件被清理
    If Not wbNew Is Nothing Then
        On Error Resume Next
        wbNew.Close SaveChanges:=False
        Set wbNew = Nothing
        On Error GoTo 0
    End If
End Sub

额外注意事项 #

• 确保Excel与Jedox插件版本兼容，避免插件层面的进程冲突
• 运行宏前关闭其他无关Excel进程，减少资源占用
• 若仍出现崩溃，可在循环内添加Application.Wait Now + TimeValue("00:00:01")，给Excel足够时间释放资源

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