更新連接字符串

Question

我只是想讓VBA更新一個OLEDB連接字符串。當我遍歷代碼時，我沒有得到任何錯誤，但連接刷新失敗，當我檢查UI中的連接字符串時，顯然我的代碼根本沒有改變它（因此刷新失敗）。我錯過了什麼？

下面是代碼：

Sub UpdateQueryConnectionString(ConnectionString As String) 

    With ActiveWorkbook.Connections("Connection Name"). _ 
     OLEDBConnection 
     .Connection = StringToArray(ConnectionString) 
    End With 
    ActiveWorkbook.Connections("Connection Name").Refresh 
End Sub 

ConnectionString中在被饋送是：

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) 

功能StringToArray被複制直出實施例4的上http://support.microsoft.com/kb/105416

Answer 1

明白了。以下代碼已工作。

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 

只要將ConnectionString作爲字符串提供，就像我在第一個問題中說明的那樣。

Answer 2

此行適用於我刷新使用OLEDB的代碼：

ActiveWorkbook.Connections("Connection Name").OLEDBConnection.Refresh 

原因似乎是，即使您引用特定的已命名連接，excel也要求您指明類型。

Answer 3

即使我們可以刷新特定的連接，反過來它會刷新所有與之相關的樞紐。

對於這個代碼，我在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