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

New data connection created when changing connection string using Excel VBA

提问by Margaret

I have a workbook that contains a pivot table which is updated by a macro. Before the data is refreshed, though, the connection string gets changed:

我有一个工作簿，其中包含一个由宏更新的数据透视表。但是，在刷新数据之前，连接字符串已更改：

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

This seems to cause the pivot table to create a new connection (called either Connectionor Data1, and I can't seem to figure out what it does to choose between them) and point itself to that. So I then have to add lines like these:

这似乎导致数据透视表创建一个新连接（称为Connectionor 或Data1，我似乎无法弄清楚它在它们之间进行选择会做什么）并指向它。所以我必须添加这样的行：

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

Which seems to work (except when it doesn't), but leaves a lot of dead connections knocking around the workbook causing confusion.

这似乎有效（除非它不起作用），但会留下很多死连接，导致工作簿周围出现混乱。

I've tried manually deleting the Connectionconnection, but then it suddenly names itself Data1itself for no apparent reason and the system gets upset because a non-existent Connectioncan't be deleted.

我试过手动删除Connection连接，但它突然Data1无缘无故地给自己命名，系统变得不安，因为Connection无法删除不存在的连接。

Is there something obvious I'm doing wrong? Is there some magic way to fix this so it doesn't create the second one in the first place to cause these kinds of headaches?

有什么明显的我做错了吗？有没有什么神奇的方法来解决这个问题，所以它不会首先创建第二个导致这些头痛的问题？

Note:I am running this code in Excel 2010, but the workbook has to be openable by 2003; however, I remove the VB module before distribution, so 2010 macro stuff is fine, it's just things in the workbook proper that might get tripped up by this...

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

回答by J Ospan

I have experienced the same problem in Excel 2010 (might be the same for earlier versions, I dunno).

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

I have tried the same approach as you i.e. changing the connection of the Pivot Table in the VBA-code AFTER I have edited the commandText of the connection string. As you, I noted sometimes success and other times failure.

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

I haven't been able to find out why the problem arises and in which cases the above mentioned approach results in success or failure.

我一直无法找出问题出现的原因，以及在何种情况下上述方法会导致成功或失败。

I have, however, found a working solution: In your VBA code, you need to perform the following steps in the said order:

但是，我找到了一个可行的解决方案：在您的 VBA 代码中，您需要按上述顺序执行以下步骤：

1. Change the commandText (which as you know results in the creation of a new connection now in use by the Pivot Table).
2. Delete the old connection string.
3. Rename the connection string from step 1 to the name of the connection string deleted in step 2.
4. Refresh the Pivot Table.

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

NB: This only works if there is only one pivot table using the connection. If you have created extra Pivot Tables by copying the first one (i.e. they share the same Pivot Cache), the above mentioned procedure won't work (and I don't know why).

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

However, if you use only one Pivot Table with the connection string the approach will work.

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

回答by john

you may add this code, after you refresh connection.

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

With ThisWorkbook
    .RefreshAll
End With

回答by Brian Pressler

I do not believe that it is the update of the connection string that is causing your problem. There is a bug when updating the CommandTextproperty of an ODBC connection that causes an extra connection to be created. If you temporarily switch to an OLEDB connection, update your CommandTextproperty and then switch back to ODBC it does not create the new connection. Don't ask me why... this just works for me.

我不认为是连接字符串的更新导致了您的问题。更新CommandTextODBC 连接的属性时存在一个错误，该错误会导致创建额外的连接。如果您临时切换到 OLEDB 连接，请更新您的CommandText属性，然后切换回 ODBC，它不会创建新连接。不要问我为什么......这对我有用。

I created a module that allows you to update the CommandText and/or Connection string. Insert this code into a new module:

我创建了一个模块，允许您更新 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

This UpdateWorkbookConnectionsubroutine only works on updating OLEDB or ODBC connections. The connection does not necessarily have to be linked to a pivot table. It also fixes another problem and allows you to update the connection even if there are multiple pivot tables based on the same connection.

此UpdateWorkbookConnection子例程仅适用于更新 OLEDB 或 ODBC 连接。连接不一定必须链接到数据透视表。它还解决了另一个问题，即使存在多个基于同一连接的数据透视表，也允许您更新连接。

To initiate the update just call the function with the connection object and command text parameters like this:

要启动更新，只需使用连接对象和命令文本参数调用函数，如下所示：

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

回答by Rene Wienholts

Had the same problem. Have a start date and end date field on the worksheet that is used to modify the period for the data in a pivot table. Added the following code for the worksheet:

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

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