New data connection created when changing connection string using Excel VBA - excel

Question

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 Connection or 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:
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 Connection connection, but then it suddenly names itself Data1 itself for no apparent reason and the system gets upset because a non-existent Connection can't be deleted.
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...

Answer 1

I have experienced the same problem in Excel 2010 (might be the same for earlier versions, I dunno).
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.
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:
Change the commandText (which as you know results in the creation of a new
connection now in use by the Pivot Table).
Delete the old connection string.
Rename the connection string from step 1 to the name of the connection string deleted in step 2.
Refresh the Pivot Table.
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.

Answer 2

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 CommandText property of an ODBC connection that causes an extra connection to be created. If you temporarily switch to an OLEDB connection, update your CommandText property and then switch back to ODBC it does not create the new connection. Don't ask me why... this just works for me.
I created a module that allows you to update the CommandText and/or Connection string. Insert this code into a new module:
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 UpdateWorkbookConnection subroutine 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.
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;..."

Answer 3

you may add this code, after you refresh connection.
With ThisWorkbook
.RefreshAll
End With

Answer 4

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