Excelmacros来更改外部数据查询连接 – 例如，从一个数据库指向另一个数据库

我正在寻找一个macros/ vbs更新所有的外部数据查询连接指向不同的服务器或数据库。 这是一个很麻烦的做法，在2007年以前的Excel版本中，有时似乎不可能手动完成。

任何人都有样品？ 我看到有不同types的连接“OLEDB”和“ODBC”，所以我想我需要处理不同格式的连接string？

Answer 1

最后，我写了下面的内容，它会提示连接详细信息，创build一个连接string，然后更新所有外部数据查询以使用该连接string。

'''' Prompts for connection details and updates all the external data connections in the workbook accordingly. '''' Changes all connections to use ODBC connections instead of OLEDB connections. '''' Could be modified to use OLEDB if there's a need for that. Sub PromptAndUpdateAllConnections() Dim Server As String, Database As String, IntegratedSecurity As Boolean, UserId As String, Password As String, ApplicationName As String Dim ConnectionString As String Dim MsgTitle As String MsgTitle = "Connection Update" If vbOK = MsgBox("You will be asked for information to connect to the database, and this spreadsheet will be updated to connect using those details.", vbOKCancel, MsgTitle) Then Server = InputBox("Database server or alias and instance name, eg 'LONDB01' or 'LONDB01\INST2'", MsgTitle) If Server = "" Then GoTo Cancelled Database = InputBox("Database name", MsgTitle, "a default value") If Database = "" Then GoTo Cancelled IntegratedSecurity = (vbYes = MsgBox("Integrated Security? (ie has your windows account been given access to connect to the database)", vbYesNo, MsgTitle)) If Not IntegratedSecurity Then UserId = InputBox("User Id", MsgTitle) If UserId = "" Then GoTo Cancelled Password = InputBox("Password", MsgTitle) If Password = "" Then GoTo Cancelled End If ApplicationName = "Excel Reporting" ConnectionString = GetConnectionString(Server, Database, IntegratedSecurity, UserId, Password, ApplicationName) UpdateAllQueryTableConnections ConnectionString MsgBox "Spreadsheet Updated", vbOKOnly, MsgTitle End If Exit Sub Cancelled: MsgBox "Spreadsheet not updated", vbOKOnly, MsgTitle End Sub '''' Generates an ODBC connection string from the given details. Function GetConnectionString(Server As String, Database As String, IntegratedSecurity As Boolean, _ UserId As String, Password As String, ApplicationName As String) Dim result As String If IntegratedSecurity Then result = "ODBC;DRIVER=SQL Server;SERVER=" & Server & ";DATABASE=" & Database _ & ";Trusted_Connection=Yes;APP=" & ApplicationName & ";" Else result = "ODBC;DRIVER=SQL Server;SERVER=" & Server & ";DATABASE=" & Database _ & ";UID=" & UserId & ";PWD=" & Password & ";APP=" & ApplicationName & ";" End If RM_GetConnectionString = result End Function '''' Sets all external data connection strings to the given value (regardless of whether they're '''' currently ODBC or OLEDB connections. Appears to change type successfully. Sub UpdateAllQueryTableConnections(ConnectionString As String) Dim w As Worksheet, qt As QueryTable Dim cn As WorkbookConnection Dim odbcCn As ODBCConnection, oledbCn As OLEDBConnection For Each cn In ThisWorkbook.Connections If cn.Type = xlConnectionTypeODBC Then Set odbcCn = cn.ODBCConnection odbcCn.SavePassword = True odbcCn.Connection = ConnectionString ElseIf cn.Type = xlConnectionTypeOLEDB Then Set oledbCn = cn.OLEDBConnection oledbCn.SavePassword = True oledbCn.Connection = ConnectionString End If Next End Sub 

Answer 2

连接string格式在很大程度上是不相关的，因为Excel将它传递给数据提供者。

手动更新一个查询表，然后执行如下操作：

 dim w as worksheet, q as querytable for each w in thisworkbook.worksheets for each q in w.querytables q.connection = SampleSheet.querytables("PreparedQueryTable").connection next next 

Answer 3

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

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

此代码适用于DB的切片器：

 Sub UpdateConnection() Dim ServerName As String Dim ConnectionString As String Dim DatabaseNameCount As Integer DatabaseNameCount = ActiveWorkbook.SlicerCaches("Slicer_Name").VisibleSlicerItems.Count If DatabaseNameCount = 1 Then ServerName = ActiveWorkbook.SlicerCaches("Slicer_Name").VisibleSlicerItems.Item(1).Name ConnectionString = GetConnectionString(ServerName) UpdateAllQueryTableConnections ConnectionString Else MsgBox "Please Select One Value", vbOKOnly, "Slicer Info" End If End Sub 

此代码适用于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 

为所需的初始目录创build连接和更新连接的通用代码：

 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 

Answer 4

oledbCn.Connection = ConnectionString在Excel 2013中导致崩溃