Microsoft Excel数据连接 – 通过VBA更改连接字符串
我有一个相当直截了当的问题.我试图通过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 希望这能帮助像我这样的其他人快速解决这个问题. (编辑:李大同) 【声明】本站内容均来自网络,其相关言论仅代表作者个人观点,不代表本站立场。若无意侵犯到您的权利,请及时与联系站长删除相关内容! |
- Windws Server 2008 R2 WEB环境配置之安装IIS方法
- Windows的哈希
- 我可以在Windows Server 2003上运行.NET 4.0 Web应用程序吗
- Office 64位中的32位dll
- windows-server-2003 – 如何确定哪些应用程序泄漏了非分页
- 在锁定或解锁Windows XP时运行脚本
- 使用IIS 7.5和Windows 7安装DotNetNuke 5.6.3时出错
- DirectX11 With Windows SDK--18 使用DirectXCollision库进
- 快捷方式 – 如何在Windows命令行中通过WSL调用Linux命令?
- windows – 虚拟机 – Azure,设置Web服务器