Excel VBA；更新连接字符串

Excel VBA; Updating a connection string

提问by Dominic

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?

我只是想让 VBA 更新 OLEDB 连接字符串。当我逐步执行代码时，我没有收到任何错误，但连接刷新失败，当我检查 UI 中的连接字符串时，很明显我的代码根本没有更改它（因此刷新失败）。我错过了什么？

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 是：

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

函数 StringToArray 直接从http://support.microsoft.com/kb/105416上的示例 4 中复制出来

采纳答案by Dominic

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.

只需将 ConnectionString 作为字符串输入，就像我在最初的问题中说明的那样。

回答by Rajiv Singh

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:

对于此代码，我从 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

回答by Sam

This line works for me to refresh code that uses OLEDB:

此行适用于我刷新使用 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.

原因似乎是即使您正在引用特定的命名连接，excel 也要求您指明类型。