【VBA】ExcelからパスワードのかかっているAccessに接続する

ExcelからパスワードのかかっているAccessにVBAで接続してみます。

ExcelからAccessにVBAで接続するときに
ADOではADODB.ConnectionのConnectionStringに
接続文字列を代入します。

Dim adoCON As New ADODB.Connection
adoCON.ConnectionString = "provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=" & dbPath & ";"

Dim adoCON As New ADODB.Connection

adoCON.ConnectionString = "provider=Microsoft.ACE.OLEDB.12.0;" & _

"Data Source=" & dbPath & ";"

しかし、パスワードがかかっているAccessファイルに接続すると
エラーが発生します。

Accessファイルの暗号化方法を変更
ExcelからパスワードのかかっているAccessに接続するコード

Accessファイルの暗号化方法を変更

ExcelからAccessに接続する前に、Accessの暗号化方法を事前に変更しておきます。

既にAccessにパスワードがかかっている場合は
Accessのパスワードを解除してから次の手順に進んでください。

Accessにパスワードがかかっている状態で、手順を進めると
ExcelからAccessの接続でエラーが発生します。

Accessファイルを開き、オプションのクライアントの設定から
暗号化方法を「以前の暗号化方法を使用する」を選択してOKを押します。

Accessファイルにtestというパスワードをかけます。

今回はテストのためパスワードを簡単なものにしています。
実際にパスワードをかける場合は、もっと複雑なものを使用してください。

パスワードを忘れるとAccessを開けなくなるので、注意してください。

ExcelからパスワードのかかっているAccessに接続するコード

ExcelからパスワードのかかっているAccessに接続し
データをコピーしてExcelに貼り付けるコードです。

パスワードのかかっているAccessには
ADODB.connectionのConnectionStringの接続文字列に
パスワードを含むことによって接続できます。

AccessファイルはMenuData.accdbというファイル名で
C:\excel-access-password\に置いてあると想定します。

Option Explicit

Sub readAccessDataWithPass()
     
  Dim dbPath As String
  dbPath = "C:\excel-access-password\MenuData.accdb"  'accdbファイルパス
  
  Dim password As String
  password = InputBox("パスワードを入力してください")
  If password = "" Then Exit Sub
  
  Dim adoCON As New ADODB.Connection
  adoCON.ConnectionString = "provider=Microsoft.ACE.OLEDB.12.0;" & _
                            "Data Source=" & dbPath & ";" & _
                            "Jet OLEDB:Database Password=" & password & ";"
  adoCON.Open
  
  Dim strSQL As String
  strSQL = "SELECT * FROM T_メニュー"
   
  Dim adoRS  As New ADODB.Recordset
  adoRS.Open strSQL, adoCON, adOpenKeyset, adLockReadOnly
   
  Dim writeSht As Worksheet
  Set writeSht = ThisWorkbook.Worksheets("Sheet1")
  writeSht.UsedRange.Clear
  
  'フィールド名の書き出し
  Dim i As Long
  For i = 0 To adoRS.Fields.Count - 1
      writeSht.Cells(1, i + 1).Value = adoRS.Fields(i).Name
  Next i
  
  'CopyFromRecordsetメソッドで基準セルを指定してデータの書き出し
  writeSht.Range("A2").CopyFromRecordset adoRS
    
  adoRS.Close
  adoCON.Close
  
  Set writeSht = Nothing
  Set adoRS = Nothing
  Set adoCON = Nothing

End Sub

Option Explicit

Sub readAccessDataWithPass()

Dim dbPath As String

dbPath = "C:\excel-access-password\MenuData.accdb" 'accdbファイルパス

Dim password As String

password = InputBox("パスワードを入力してください")

If password = "" Then Exit Sub

Dim adoCON As New ADODB.Connection

adoCON.ConnectionString = "provider=Microsoft.ACE.OLEDB.12.0;" & _

"Data Source=" & dbPath & ";" & _

"Jet OLEDB:Database Password=" & password & ";"

adoCON.Open

Dim strSQL As String

strSQL = "SELECT * FROM T_メニュー"

Dim adoRS As New ADODB.Recordset

adoRS.Open strSQL, adoCON, adOpenKeyset, adLockReadOnly

Dim writeSht As Worksheet

Set writeSht = ThisWorkbook.Worksheets("Sheet1")

writeSht.UsedRange.Clear

'フィールド名の書き出し

Dim i As Long

For i = 0 To adoRS.Fields.Count - 1

writeSht.Cells(1, i + 1).Value = adoRS.Fields(i).Name

Next i

'CopyFromRecordsetメソッドで基準セルを指定してデータの書き出し

writeSht.Range("A2").CopyFromRecordset adoRS

adoRS.Close

adoCON.Close

Set writeSht = Nothing

Set adoRS = Nothing

Set adoCON = Nothing

End Sub

接続文字列にpasswordを含んでいます。

  adoCON.ConnectionString = "provider=Microsoft.ACE.OLEDB.12.0;" & _
                            "Data Source=" & dbPath & ";" & _
                            "Jet OLEDB:Database Password=" & password & ";"