Microsoft Excel数据连接 – 通过VBA更改连接string
我有一个相当直接的问题。 我想通过VBA（macros代码）find一种方法来更改和更改Excel工作簿中的现有数据连接的连接string。 我试图做到这一点的主要原因是find一种方法来提示打开工作簿的用户input他们的凭证（用户名/密码），或者在可用连接string中使用可信任连接的checkbox数据连接。
现在，数据连接运行的是我创build的示例用户，并且需要在生产版本的工作簿中消失。 希望有道理？
这可能吗？ 如果是，请给我一个示例代码块？ 我真的很感谢在这一点上的任何build议。
我也有这个完全相同的要求，虽然重复的问题Excelmacros来改变外部数据查询连接 – 例如从一个数据库指向另一个是有用的，我仍然不得不修改它以满足上述确切的要求。 我正在使用特定的连接，而这个答案针对多个连接。 所以，我在这里包括了我的工作。 感谢@Rory的代码。
还要感谢Luke Maxwell为他的functionsearch匹配关键字的string 。
将此子分配给一个button，或在电子表格打开时调用它。
Sub GetConnectionUserPassword() Dim Username As String, Password As String Dim ConnectionString As String Dim MsgTitle As String MsgTitle = "My Credentials" If vbOK = MsgBox("You will be asked for your username and password.", vbOKCancel, MsgTitle) Then Username = InputBox("Username", MsgTitle) If Username = "" Then GoTo Cancelled Password = InputBox("Password", MsgTitle) If Password = "" Then GoTo Cancelled Else GoTo Cancelled End If ConnectionString = GetConnectionString(Username, Password) ' MsgBox ConnectionString, vbOKOnly UpdateQueryConnectionString ConnectionString MsgBox "Credentials Updated", vbOKOnly, MsgTitle Exit Sub Cancelled: MsgBox "Credentials have not been changed.", vbOKOnly, MsgTitle End Sub
GetConnectionString函数存储您插入用户名和密码的连接string。 这是一个OLEDB连接，根据提供商的要求，显然是不同的。
Function GetConnectionString(Username As String, Password As String) Dim result As Variant result = "OLEDB;Provider=Your Provider;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) ' MsgBox result, vbOKOnly GetConnectionString = result End Function
这段代码完成了用新连接string实际更新命名连接的工作（对于OLEDB连接）。
Sub UpdateQueryConnectionString(ConnectionString As String) Dim cn As WorkbookConnection Dim oledbCn As OLEDBConnection Set cn = ThisWorkbook.Connections("Your Connection Name") Set oledbCn = cn.OLEDBConnection oledbCn.Connection = ConnectionString End Sub
相反，你可以使用这个函数来得到当前的连接string。
Function ConnectionString() Dim Temp As String Dim cn As WorkbookConnection Dim oledbCn As OLEDBConnection Set cn = ThisWorkbook.Connections("Your Connection Name") Set oledbCn = cn.OLEDBConnection Temp = oledbCn.Connection ConnectionString = Temp End Function
我打开工作簿时使用这个子刷新数据，但在刷新之前检查连接string中是否有用户名和密码。 我只是从私人小组Workbook_Open（）调用这个子。
Sub RefreshData() Dim CurrentCredentials As String Sheets("Sheetname").Unprotect Password:="mypassword" CurrentCredentials = ConnectionString() If ListSearch(CurrentCredentials, "None", "") > 0 Then GetConnectionUserPassword End If Application.ScreenUpdating = False ActiveWorkbook.Connections("My Connection Name").Refresh Sheets("Sheetname").Protect _ Password:="mypassword", _ UserInterfaceOnly:=True, _ AllowFiltering:=True, _ AllowSorting:=True, _ AllowUsingPivotTables:=True End Sub
这是来自Luke的ListSearch函数。 它返回find的匹配数量。
Function ListSearch(text As String, wordlist As String, seperator As String, Optional caseSensitive As Boolean = False) Dim intMatches As Integer Dim res As Variant Dim arrWords() As String intMatches = 0 arrWords = Split(wordlist, seperator) On Error Resume Next Err.Clear For Each word In arrWords If caseSensitive = False Then res = InStr(LCase(text), LCase(word)) Else res = InStr(text, word) End If If res > 0 Then intMatches = intMatches + 1 End If Next word ListSearch = intMatches End Function
最后，如果您希望能够删除证书，只需将该子项分配给一个button即可。
Sub RemoveCredentials() Dim ConnectionString As String ConnectionString = GetConnectionString("None", "None") UpdateQueryConnectionString ConnectionString MsgBox "Credentials have been removed.", vbOKOnly, "Your Credentials" End Sub
希望这能帮助像我这样的人快速解决这个问题。
这是Excelmacros的一个副本， 用于更改外部数据查询连接 – 例如，从一个数据库指向另一个数据库
看起来主要是使用VBA中的ThisWorkbook.Connections。