Question

我有一个相当直截了当的问题。我试图通过VBA（宏代码）找到一种方法来改变和更改excel工作簿中现有数据连接的连接字符串。我尝试这样做的主要原因是找到一种方法来提示打开工作簿的用户输入他们的凭据（用户名/密码）或者有一个可信连接的复选框，该复选框将在现有的连接字符串中使用数据连接。

Data Connection Properties

现在，数据连接正在运行我创建的示例用户，并且需要在工作簿的生产版本中消失。希望有道理吗？

这可能吗？如果是的话，你能给我一个示例/示例代码块吗？在此，我真的很感激任何建议。

Answer 1

我也有完全相同的要求，虽然重复的问题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.", vbOKOnly, 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

我在打开工作簿时使用此sub刷新数据，但在执行刷新之前检查连接字符串中是否有用户名和密码。我只是从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.", vbOKOnly, "Your Credentials"
End Sub

希望这能帮助像我这样的人快速解决这个问题。

Answer 2

这是Excel macro to change external data query connections - e.g. point from one database to another

的副本

看起来主要是在VBA中使用ThisWorkbook.Connections。

Microsoft Excel数据连接 - 通过VBA更改连接字符串

2 个答案: