I’m just trying to get VBA to update an OLEDB connection string. When I step through the code, I don’t get any errors but the connection refresh fails and when I examine the connection string in the UI, it’s obvious that my code has not changed it at all (hence the refresh failure). What have I missed?
Here is the code:
Sub UpdateQueryConnectionString(ConnectionString As String)
With ActiveWorkbook.Connections("Connection Name"). _
OLEDBConnection
.Connection = StringToArray(ConnectionString)
End With
ActiveWorkbook.Connections("Connection Name").Refresh
End Sub
The ConnectionString being fed in is:
ConnectionString = = "Provider=SLXOLEDB.1;Data Source=SERVER;Initial Catalog=DATABASE" _
& ";User ID=" & Username & ";Password=" & Password & _
";Persist Security Info=True;Extended Properties=" _
& Chr(34) & "PORT=1706;LOG=ON;CASEINSENSITIVEFIND=ON;INCLUDECALCFIELDS=ON;" & Chr(34)
The function StringToArray is copied straight out of Example 4 on http://support.microsoft.com/kb/105416
Got it. The following code has worked.
Sub UpdateQueryConnectionString(ConnectionString As String)
Dim cn As WorkbookConnection
Dim oledbCn As OLEDBConnection
Set cn = ThisWorkbook.Connections("Connection Name")
Set oledbCn = cn.OLEDBConnection
oledbCn.Connection = ConnectionString
End Sub
Just feed ConnectionString in as a string like I illustrated in my initial question.
Answer:
This line works for me to refresh code that uses OLEDB:
ActiveWorkbook.Connections("Connection Name").OLEDBConnection.Refresh
The reason seems to be that excel requires you to indicate the type even if you are referencing a specific, named, connection.
Answer:
Even we can refresh particular connection and in turn it will refresh all the pivots linked to it.
For this code I have created slicer from table present in Excel:
Sub UpdateConnection()
Dim ServerName As String
Dim ServerNameRaw As String
Dim CubeName As String
Dim CubeNameRaw As String
Dim ConnectionString As String
ServerNameRaw = ActiveWorkbook.SlicerCaches("Slicer_ServerName").VisibleSlicerItemsList(1)
ServerName = Replace(Split(ServerNameRaw, "[")(3), "]", "")
CubeNameRaw = ActiveWorkbook.SlicerCaches("Slicer_CubeName").VisibleSlicerItemsList(1)
CubeName = Replace(Split(CubeNameRaw, "[")(3), "]", "")
If CubeName = "All" Or ServerName = "All" Then
MsgBox "Please Select One Cube and Server Name", vbOKOnly, "Slicer Info"
Else
ConnectionString = GetConnectionString(ServerName, CubeName)
UpdateAllQueryTableConnections ConnectionString, CubeName
End If
End Sub
Function GetConnectionString(ServerName As String, CubeName As String)
Dim result As String
result = "OLEDB;Provider=MSOLAP.5;Integrated Security=SSPI;Persist Security Info=True;Initial Catalog=" & CubeName & ";Data Source=" & ServerName & ";MDX Compatibility=1;Safety Options=2;MDX Missing Member Mode=Error;Update Isolation Level=2"
'"OLEDB;Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=True;Initial Catalog=" & CubeName & ";Data Source=" & ServerName & ";Use Procedure for Prepare=1;Auto Translate=True;Packet Size=4096;Use Encryption for Data=False;Tag with column collation when possible=False"
GetConnectionString = result
End Function
Sub UpdateAllQueryTableConnections(ConnectionString As String, CubeName As String)
Dim cn As WorkbookConnection
Dim oledbCn As OLEDBConnection
Dim Count As Integer, i As Integer
Dim DBName As String
DBName = "Initial Catalog=" + CubeName
Count = 0
For Each cn In ThisWorkbook.Connections
If cn.Name = "ThisWorkbookDataModel" Then
Exit For
End If
oTmp = Split(cn.OLEDBConnection.Connection, ";")
For i = 0 To UBound(oTmp) - 1
If InStr(1, oTmp(i), DBName, vbTextCompare) = 1 Then
Set oledbCn = cn.OLEDBConnection
oledbCn.SavePassword = True
oledbCn.Connection = ConnectionString
Count = Count + 1
End If
Next
Next
If Count = 0 Then
MsgBox "Nothing to update", vbOKOnly, "Update Connection"
ElseIf Count > 0 Then
MsgBox "Connection Updated Successfully", vbOKOnly, "Update Connection"
End If
End Sub
Tags: excelexcel, string, vba