web-dev-qa-db-ja.com

MicrosoftExcelデータ接続-VBAを介して接続文字列を変更する

かなり簡単な質問があります。 VBA（マクロコード）を使用して、Excelブック内の既存のデータ接続の接続文字列を変更および変更する方法を見つけようとしています。私がこれを行おうとしている主な理由は、ブックを開いたユーザーに資格情報（ユーザー名/パスワード）の入力を求める方法、または既存の接続文字列で使用される信頼できる接続のチェックボックスを設定する方法を見つけることです。データ接続。

Data Connection Properties

現在、データ接続は、私が作成したサンプルユーザーから実行されており、ブックの製品版では削除する必要があります。それが理にかなっていることを願っていますか？

これは可能ですか？はいの場合、サンプル/サンプルコードブ​​ロックを教えてください。この時点で何か提案をいただければ幸いです。

excelvbaexcel-vbaodbcconnection-string
6
SillyCoda

私もこれとまったく同じ要件があり、重複した質問 外部データクエリ接続を変更するExcelマクロ-たとえば、あるデータベースから別のデータベースへのポイント は役に立ちましたが、上記の正確な要件を満たすために変更する必要がありました。私は特定の接続で作業していましたが、その回答は複数の接続を対象としていました。それで、私はここに私の働きを含めました。ありがとう @ Rory 彼のコードをありがとう。

また、 Luke Maxwell の機能に感謝します 文字列で一致するキーワードを検索します 。

このサブをボタンに割り当てるか、スプレッドシートを開いたときに呼び出します。

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

このサブを使用して、ブックを開いたときにデータを更新しますが、更新を実行する前に、接続文字列にユーザー名とパスワードがあることを確認します。このサブをPrivateSub 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

これが、この問題を迅速に解決しようとしていた私のような別の人に役立つことを願っています。

10
Dominic