Excel VBA：删除工作簿中数据透视表未使用的连接

问题背景 #

工作簿包含约25个工作表，每个工作表至少有一个数据透视表。现有宏会读取多工作表输入文件、检测数据区域并添加OLEDB连接，用新连接替换透视表的默认连接，但旧连接未被移除，长期积累后已有800+冗余连接，导致工作簿响应速度明显变慢。需要实现：遍历所有连接，删除未被任何数据透视表使用的冗余连接。

原代码的核心问题 #

原代码中错误地将pt.PivotCache.Connection（返回连接字符串）与conn.Name（连接名称）直接对比，导致无法匹配有效连接，最终所有连接被误删。此外尝试直接对比Connection对象、读取pt.PivotCache.Connection.Name均失败，因为PivotCache.Connection并非返回WorkbookConnection对象，而是字符串类型的连接字符串。

可行解决方案 #

核心思路是：先收集所有被数据透视表实际使用的OLEDB连接名称，再遍历工作簿所有连接，删除不在该列表中的冗余连接。

完整实现代码 #

Sub 删除未使用的OLEDB连接()
    Dim wb As Workbook
    Dim 已使用连接集合 As Collection
    Dim 工作表 As Worksheet
    Dim 透视表 As PivotTable
    Dim OLEDB连接 As OLEDBConnection
    Dim 工作簿连接 As WorkbookConnection
    Dim i As Long
    Dim 是否被使用 As Boolean
    
    ' 指向当前工作簿
    Set wb = ThisWorkbook
    ' 初始化集合存储已使用的连接名称（自动去重）
    Set 已使用连接集合 = New Collection
    
    ' 遍历所有工作表的透视表，收集已使用的连接名称
    On Error Resume Next ' 跳过非OLEDB数据源的透视表
    For Each 工作表 In wb.Worksheets
        For Each 透视表 In 工作表.PivotTables
            ' 判断是否为外部数据源（OLEDB连接属于此类）
            If 透视表.PivotCache.SourceType = xlExternal Then
                Set OLEDB连接 = 透视表.PivotCache.OLEDBConnection
                ' 将连接名称加入集合，Key参数避免重复添加
                已使用连接集合.Add OLEDB连接.Name, Key:=OLEDB连接.Name
            End If
        Next 透视表
    Next 工作表
    On Error GoTo 0 ' 恢复错误处理
    
    ' 反向遍历所有连接（避免删除时索引混乱）
    For i = wb.Connections.Count To 1 Step -1
        Set 工作簿连接 = wb.Connections(i)
        是否被使用 = False
        
        ' 检查当前连接是否在已使用列表中
        On Error Resume Next
        已使用连接集合.Item(工作簿连接.Name)
        ' 若未触发错误，说明连接已被使用
        If Err.Number = 0 Then 是否被使用 = True
        On Error GoTo 0
        
        ' 删除未被使用的连接
        If Not 是否被使用 Then
            工作簿连接.Delete
        End If
    Next i
End Sub

代码说明 #

1. 收集已使用连接：遍历所有工作表的透视表，仅处理外部数据源类型的透视表（OLEDB连接属于此类），通过PivotCache.OLEDBConnection获取对应的连接对象，将其名称存入集合（利用集合的Key参数自动去重）。
2. 删除冗余连接：反向遍历工作簿的所有连接（避免删除元素时导致索引错位），通过集合的Item方法判断连接是否被使用，未被使用则直接删除。

替换新连接时同步删除旧连接的补充方案 #

如果需要在替换透视表连接时同步清理旧连接，可在替换逻辑中记录旧连接名称，替换完成后调用上述删除宏（或直接删除旧连接，需确保无其他透视表依赖该连接）：

Sub 替换透视表连接并清理旧连接()
    Dim wb As Workbook
    Dim 新连接 As WorkbookConnection
    Dim 工作表 As Worksheet
    Dim 透视表 As PivotTable
    Dim 旧连接名称 As String
    
    Set wb = ThisWorkbook
    ' 假设已创建好新的OLEDB连接并赋值给新连接变量
    ' Set 新连接 = wb.Connections.Add2(...)
    
    ' 遍历透视表替换连接
    For Each 工作表 In wb.Worksheets
        For Each 透视表 In 工作表.PivotTables
            If 透视表.PivotCache.SourceType = xlExternal Then
                ' 记录旧连接名称
                旧连接名称 = 透视表.PivotCache.OLEDBConnection.Name
                ' 应用新连接的配置
                透视表.PivotCache.Connection = 新连接.OLEDBConnection.Connection
                透视表.PivotCache.CommandText = 新连接.OLEDBConnection.CommandText
                透视表.PivotCache.Refresh
            End If
        Next 透视表
    Next 工作表
    
    ' 调用删除宏清理所有未使用的连接（包括刚替换的旧连接）
    Call 删除未使用的OLEDB连接
End Sub

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