我有一个相当直截了当的问题.我试图通过VBA(宏代码)找到一种方法来更改和更改excel工作簿中现有数据连接的连接字符串.我尝试这样做的主要原因是找到一种方法来提示用户打开工作簿以输入其凭据(用户名/密码),或者有一个可信连接的复选框,该复选框将用于现有连接字符串的连接字符串中数据连接.
现在,数据连接正在运行我创建的示例用户,并且需要在工作簿的生产版本中消失.希望有道理吗?
这可能吗?如果是的话,你能给我一个示例/示例代码块吗?在这一点上,我真的很感激任何建议.
我也有完全相同的要求,虽然重复的问题
Excel macro to change external data query connections – e.g. point from one database to another很有用,但我仍然需要修改它以满足上面的确切要求.我正在使用特定的连接,而该答案针对多个连接.所以,我把我的工作包括在这里.谢谢
@Rory的代码.
还要感谢Luke Maxwell,他的功能是search a string for matching keywords.
将此子分配给按钮或在打开电子表格时调用它.
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.",MsgTitle End Sub
GetConnectionString函数存储您插入用户名和密码的连接字符串.这个用于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
此代码完成了使用新连接字符串实际更新命名连接的工作(对于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
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
我在打开工作簿时使用此子命令刷新数据但在执行刷新之前检查连接字符串中是否有用户名和密码.我只是从Private Sub 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函数.它返回它找到的匹配数.
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
最后,如果您希望能够删除凭据,只需将此子分配给按钮即可.
Sub RemoveCredentials() Dim ConnectionString As String ConnectionString = GetConnectionString("None","None") UpdateQueryConnectionString ConnectionString MsgBox "Credentials have been removed.","Your Credentials" End Sub