Excel VBA;更新连接字符串

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

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

3 个解决方案

#1

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作为字符串提供,就像我在初始问题中所说明的那样。

#2

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要求您指明类型,即使您引用特定的命名连接。

#3

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

#1