Excel VBA; Обновление строки подключения

Question

Я просто пытаюсь получить VBA для обновления строки подключения OLEDB. Когда я перехожу к коду, я не получаю никаких ошибок, но обновление соединения завершается с ошибкой, и когда я проверяю строку подключения в пользовательском интерфейсе, очевидно, что мой код вообще не изменил его (следовательно, сбой обновления). Что я пропустил?

Вот код:

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

Got it. Следующий код работал.

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