使用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

这似乎是有效的（除非它不起作用），但会在工作簿中留下很多无效连接，导致混乱。我尝试手动删除“连接”，但出现某种原因导致它突然将自己命名为“Data1”，系统因无法删除不存在的“连接”而感到不满。是否有明显错误？是否有某种神奇的方法可以修复它，使其不会首先创建第二个连接，从而引起这些头痛？注意：我在Excel 2010中运行此代码，但必须能够打开2003的工作簿；但是，我在分发之前删除VB模块，因此2010宏内容是可以的，只是工作簿中的事情可能会受到这种问题的影响...

- Margaret

---

有一件事我还没有完全理解。每次都需要更改连接吗？还是由Excel自动完成的？ - pintxo

@cmmi: 每次都需要更改连接 - 这是为我们公司的所有客户运行的报告，每次只有该客户的数据。 - Margaret

Answer 1

我在Excel 2010中遇到了同样的问题（早期版本可能也是如此，我不确定）。

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

我无法找出为什么会出现这个问题以及在哪些情况下上述方法会导致成功或失败。

然而，我找到了一个可行的解决方案： 在您的VBA代码中，您需要按照以下步骤进行：

1. 更改commandText（正如您所知道的那样，这将导致创建一个新的连接，现在由数据透视表使用）。
2. 删除旧的连接字符串。
3. 将步骤1中的连接字符串重命名为步骤2中删除的连接字符串的名称。
4. 刷新数据透视表。

NB：仅当只有一个数据透视表使用该连接时，此方法才有效。如果您通过复制第一个数据透视表创建了额外的数据透视表（即它们共享相同的数据透视缓存），则上述过程将无效（我不知道为什么）。

但是，如果您只使用一个数据透视表和连接字符串，则该方法有效。

- J Ospan

Answer 2

我不认为更新连接字符串是导致您问题的原因。在更新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;..."

- Brian Pressler

---

这个方法非常巧妙地解决了我的问题，而且不需要删除不必要的连接。我已经测试过它可以适用于两个连接，一个带有一个数据透视表，另一个带有两个。 - Zajonc

Answer 3

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

With ThisWorkbook
    .RefreshAll
End With

- john

Answer 4

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

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

- Rene Wienholts