使用Excel VBA更改连接字符串时创建的新数据连接

Question

我有一个工作簿，其中包含由宏更新的数据透视表。该数据被刷新之前，虽然，连接字符串得到改变：

With ThisWorkbook.Connections("Data").ODBCConnection 
    .Connection = [Redacted] 
    .CommandText = "EXEC ExtractCases " & Client 
    .BackgroundQuery = False 
    .Refresh 
End With 

这似乎会导致数据透视表创建一个新的连接（或者叫做Connection或Data1，我似乎无法找出什么它的确可以在它们之间做出选择）并且指出这一点。所以，我再要补充线这样的：

Sheets("Pivot").PivotTables("Pivot").ChangeConnection ThisWorkbook.Connections("Data") 
Sheets("Pivot").PivotTables("Pivot").PivotCache.Refresh 

这似乎工作（当它不除外），但留下了很多死连接工作簿敲周围造成混乱。

我已经试过手动删除Connection连接，但随后突然名字本身Data1本身没有明显的原因，系统被打乱，因为不存在Connection不能被删除。

有什么明显的我做错了吗？是否有一些神奇的方法可以解决这个问题，所以它不会在第一个地方造成这种头痛？

注意：我在Excel 2010中运行此代码，但工作簿必须在2003年之前可以打开;然而，我在发布之前删除了VB模块，所以2010宏的东西很好，只是在工作簿中的东西可能会被绊倒... ...

Answer 1

我在Excel 2010中遇到过同样的问题（可能是相同的早期版本，我不知道）。

我已经尝试了与您相同的方法，即在编辑连接字符串的commandText后，更改了VBA代码中的数据透视表的连接。和你一样，我注意到有时候成功和其他时候失败。

我还没有找到问题出现的原因，以及上述方法在哪些情况下会导致成功或失败。

我有，但是，找到一个有效的解决方案： 在你的VBA代码，您需要执行上述命令如下步骤：

1. 更改CommandText的（正如你知道的结果创建数据透视表正在使用的新的 连接）。
2. 删除旧的连接字符串。
3. 将步骤1中的连接字符串重命名为在步骤2中删除的连接字符串的名称。
4. 刷新数据透视表。

注意：这只适用于只有一个透视表使用连接。如果您通过复制第一个透视表（即它们共享相同的透视缓存）创建了额外的透视表，上述过程将不起作用（我不知道为什么）。

但是，如果您只使用一个透视表和连接字符串，则该方法将起作用。

Answer 2

刷新连接后，您可以添加此代码。

With ThisWorkbook 
    .RefreshAll 
End With 

Answer 3

有同样的问题。工作表上有一个开始日期和结束日期字段，用于修改数据透视表中数据的周期。为工作表添加了以下代码：

Private Sub Worksheet_Change(ByVal Target As Range) 
    'Update the query when the date range has been changed. 
    If (Target.Row = Worksheets("Revenue").Range("StartDate").Row Or _ 
     Target.Row = Worksheets("Revenue").Range("EndDate").Row) And _ 
     Target.Column = Worksheets("Revenue").Range("StartDate").Column Then 

     FilterTableData 

    End If 
End Sub 

Sub FilterTableData() 
    'Declare variables 
    Dim noOfConnections As Integer 
    Dim loopCount As Integer 
    Dim conn As WorkbookConnection 
    Dim connectionName As String 
    Dim startDate As Date 
    Dim endDate As Date 
    Dim strMonth As String 
    Dim strDay As String 
    Dim startDateString As String 
    Dim endDateString As String 

    'Remove current connections 
    'Note: Excel creates a new connection with a new name as soon as you change the query for the connection. To avoid 
    ' ending up with multiple connections delete all connections and start afresh. 

    'First delete all fake connections 
    noOfConnections = ActiveWorkbook.Connections.Count 
    For loopCount = noOfConnections To 1 Step -1 
     Set conn = ActiveWorkbook.Connections.Item(loopCount) 
     If conn Is Nothing Then 
      conn.Delete 
     End If 
    Next loopCount 

    'Then delete all extra connections 
    noOfConnections = ActiveWorkbook.Connections.Count 
    For loopCount = noOfConnections To 1 Step -1 
     If loopCount = 1 Then 
      Set conn = ActiveWorkbook.Connections.Item(loopCount) 
      conn.Name = "Connection1" 
     Else 
      Set conn = ActiveWorkbook.Connections.Item(loopCount) 
      conn.Delete 
     End If 
    Next loopCount 

    'Create date strings for use in query. 
    startDate = Worksheets("Revenue").Range("B1") 
    strDay = Day(startDate) 
    If Len(strDay) = 1 Then 
     strDay = "0" & strDay 
    End If 
    strMonth = Month(startDate) 
    If Len(strMonth) = 1 Then 
     strMonth = "0" & strMonth 
    End If 
    startDateString = Year(startDate) & "-" & strMonth & "-" & strDay & " 00:00:00" 

    endDate = Worksheets("Revenue").Range("B2") 
    strDay = Day(endDate) 
    If Len(strDay) = 1 Then 
     strDay = "0" & strDay 
    End If 
    strMonth = Month(endDate) 
    If Len(strMonth) = 1 Then 
     strMonth = "0" & strMonth 
    End If 
    endDateString = Year(endDate) & "-" & strMonth & "-" & strDay & " 00:00:00" 

    'Modify the query in accordance with the new date range 
    With conn.ODBCConnection 
     .CommandText = Array(_ 
     "SELECT INVOICE.ACCOUNT_PERIOD, INVOICE.INVOICE_NUMBER, INVOICE_ITEM.LAB, INVOICE_ITEM.TOTAL_PRICE, ", _ 
     "INVOICE.INVOICED_ON" & Chr(13) & "" & Chr(10) & _ 
     "FROM Lab.dbo.INVOICE INVOICE, Lab.dbo.INVOICE_ITEM INVOICE_ITEM" & Chr(13) & "" & Chr(10) & _ 
     "WHERE INVOICE.INVOICE_NUMBER = INVOICE_ITEM.INVOICE_NUMBER AND ", _ 
     "INVOICE.INVOICED_ON > {ts '" & startDateString & "'} AND INVOICE.INVOICED_ON < {ts '" & endDateString & "'} ") 
    End With 

    'Refresh the data and delete any surplus connections 
    noOfConnections = ActiveWorkbook.Connections.Count 
    If noOfConnections = 1 Then 
     'Rename connection 
     ActiveWorkbook.Connections.Item(1).Name = "Connection" 

     'Refresh the data 
     ActiveWorkbook.Connections("Connection").Refresh 
    Else 
     'Refresh the data 
     ActiveWorkbook.Connections("Connection").Refresh 

     'Delete the old connection 
     ActiveWorkbook.Connections("Connection1").Delete 
    End If 

    'Refresh the table 
    ActiveSheet.PivotTables("Revenue").Update 
End Sub 

Answer 4

我不相信它是导致您的问题的连接字符串的更新。更新导致创建额外连接的ODBC连接的CommandText属性时存在错误。如果您临时切换到OLEDB连接，请更新您的CommandText属性，然后切换回ODBC，它不会创建新连接。不要问我为什么......这只适用于我。

我创建了一个模块，允许您更新CommandText和/或连接字符串。插入此代码到一个新的模块：

Option Explicit 

Sub UpdateWorkbookConnection(WorkbookConnectionObject As WorkbookConnection, Optional ByVal CommandText As String = "", Optional ByVal ConnectionString As String = "") 

With WorkbookConnectionObject 
    If .Type = xlConnectionTypeODBC Then 
     If CommandText = "" Then CommandText = .ODBCConnection.CommandText 
     If ConnectionString = "" Then ConnectionString = .ODBCConnection.Connection 
     .ODBCConnection.Connection = Replace(.ODBCConnection.Connection, "ODBC;", "OLEDB;", 1, 1, vbTextCompare) 
    ElseIf .Type = xlConnectionTypeOLEDB Then 
     If CommandText = "" Then CommandText = .OLEDBConnection.CommandText 
     If ConnectionString = "" Then ConnectionString = .OLEDBConnection.Connection 
    Else 
     MsgBox "Invalid connection object sent to UpdateWorkbookConnection function!", vbCritical, "Update Error" 
     Exit Sub 
    End If 
    If StrComp(.OLEDBConnection.CommandText, CommandText, vbTextCompare) <> 0 Then 
     .OLEDBConnection.CommandText = CommandText 
    End If 
    If StrComp(.OLEDBConnection.Connection, ConnectionString, vbTextCompare) <> 0 Then 
     .OLEDBConnection.Connection = ConnectionString 
    End If 
    .Refresh 
End With 

End Sub 

这UpdateWorkbookConnection子程序只能在更新OLEDB或ODBC连接。连接不一定必须链接到数据透视表。它还修复了另一个问题，即使存在多个基于同一连接的数据透视表，也可以更新连接。

启动更新只是使用连接对象和命令文本参数，像这样的功能：

UpdateWorkbookConnection ActiveWorkbook.Connections("Connection"), "exec sp_MyAwesomeProcedure", "ODBC;..."