Excel VBA; 更新连接string

我只是想让VBA更新一个OLEDB连接string。 当我遍历代码时，我没有得到任何错误，但连接刷新失败，当我检查UI中的连接string时，显然我的代码根本没有改变（因此刷新失败）。 我错过了什么？

这里是代码：

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直接从http://support.microsoft.com/kb/105416上的示例4复制而来

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作为string提供。

Answer 2

此行适用于刷新使用OLEDB的代码：

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

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

Answer 3

即使我们可以刷新特定的联系，反过来也会刷新与之相关的所有支点。

对于这个代码，我从Excel中的表格创build了切片器：

 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