vba Excel 宏更改外部数据查询连接 - 例如从一个数据库指向另一个
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/2708086/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Excel macro to change external data query connections - e.g. point from one database to another
提问by Rory
I'm looking for a macro/vbs to update all the external data query connections to point at a different server or database. This is a pain to do manually and in versions of Excel before 2007 it sometimes seems impossible to do manually.
我正在寻找一个宏/vbs 来更新所有外部数据查询连接以指向不同的服务器或数据库。这很难手动完成，在 2007 年之前的 Excel 版本中，有时似乎无法手动完成。
Anyone have a sample? I see there are different types of connections 'OLEDB' and 'ODBC', so I guess I need to deal with different formats of connection strings?
有人有样品吗？我看到有不同类型的连接“OLEDB”和“ODBC”，所以我想我需要处理不同格式的连接字符串？
回答by Rory
I ended up writing the following, which prompts for the connection details, creates a connection string, then updates all external data queries to use that connection 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, e.g. '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? (i.e. 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
回答by GSerg
Connection string format is largely irrelevant as Excel will pass it to data providers.
连接字符串格式在很大程度上无关紧要，因为 Excel 会将其传递给数据提供程序。
Update one querytable manually, then do something like this:
手动更新一个查询表，然后执行如下操作：
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
回答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 中的表创建了切片器：
This code is for Slicer from DB:
此代码适用于来自 DB 的 Slicer：
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
This code is for Slicer created from Excel table present in same workbook:
此代码适用于从同一工作簿中存在的 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
Common code to create connection and update connection for desired Initial Catalog:
为所需的初始目录创建连接和更新连接的通用代码：
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
