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

时间:2011-05-10 00:38:39

标签: excel-vba vba excel

我有一个工作簿,其中包含一个由宏更新的数据透视表。但是,在刷新数据之前,连接字符串会发生变化:

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

这似乎会导致数据透视表创建一个新连接(称为ConnectionData1,而我似乎无法弄清楚它们之间的选择)并指出自己那个。所以我必须添加这样的行:

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

这似乎有效(除非它没有),但是在工作簿周围留下了很多死连接导致混淆。

我已尝试手动删除Connection连接,但之后它突然命名自己Data1本身没有明显的原因,系统因为不存在的Connection可能会感到不安被删除。

有什么明显我做错了吗?是否有一些神奇的方法可以解决这个问题,因此它不会在第一时间造成第二个导致这类头痛的方法?

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

4 个答案:

答案 0 :(得分:3)

我在Excel 2010中遇到了同样的问题(对于早期版本可能是相同的,我不知道)。

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

我无法找出问题出现的原因,以及上述方法导致成功或失败的情况。

然而,

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

  1. 更改commandText(如您所知,导致创建新的 现在由数据透视表使用的连接。)
  2. 删除旧的连接字符串。
  3. 将步骤1中的连接字符串重命名为步骤2中删除的连接字符串的名称。
  4. 刷新数据透视表。
  5. 注意:这仅在使用连接只有一个数据透视表时才有效。如果您通过复制第一个数据透视表创建了额外的数据透视表(即它们共享相同的数据透视表缓存),则上述过程将不起作用(我不知道为什么)。

    但是,如果只使用一个带有连接字符串的数据透视表,则该方法将起作用。

答案 1 :(得分:1)

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

With ThisWorkbook
    .RefreshAll
End With

答案 2 :(得分:1)

我不相信这是导致问题的连接字符串的更新。更新ODBC连接的CommandText属性时会出现一个错误,导致创建额外的连接。如果您暂时切换到OLEDB连接,请更新您的CommandText属性,然后切换回ODBC,它不会创建新连接。不要问我为什么......这对我有用。

我创建了一个模块,允许您更新CommandText和/或Connection字符串。将此代码插入新模块:

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;..."

答案 3 :(得分:0)

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

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