Новое подключение к данным создается при изменении строки подключения с помощью 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 (может быть, то же самое для более ранних версий, я не знаю).

Я испробовал тот же подход, что и вы, т. Е. Изменил соединение сводной таблицы в VBA-коде ПОСЛЕ того, как я отредактировал commandText строки соединения. Как вы, я иногда отмечал успех, а иногда неудачу.

Мне не удалось выяснить, почему возникает проблема и в каких случаях вышеупомянутый подход приводит к успеху или неудаче.

Однако я нашел рабочее решение : В своем коде VBA необходимо выполнить следующие шаги в указанном порядке:

1. Измените commandText (который, как вы знаете, приводит к созданию нового соединение используется в сводной таблице).
2. Удалить старую строку подключения.
3. Переименуйте строку подключения с шага 1 в имя строки подключения, удаленной на шаге 2.
4. Обновите сводную таблицу.

NB. Это работает, только если для подключения используется только одна сводная таблица. Если вы создали дополнительные сводные таблицы, скопировав первую (т.е. они используют один и тот же сводный кэш), вышеупомянутая процедура не будет работать (и я не знаю, почему).

Однако, если вы используете только одну сводную таблицу со строкой подключения, подход будет работать.

Answer 2

Я не верю, что это проблема обновления строки подключения.При обновлении свойства CommandText соединения ODBC возникает ошибка, которая приводит к созданию дополнительного соединения.Если вы временно переключаетесь на соединение 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;..."

Answer 3

Вы можете добавить этот код после обновления соединения.

With ThisWorkbook
    .RefreshAll
End With

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