ADOはOLEDBとも称されるデータベースへの比較的新しい接続方法です。
(画像をクリックすると、このページのサンプルがダウンロードできます)
「
MDB(ACCDB)配属一覧
.xlsm」を開いて下さい。
このようにマクロを起動させて下さい。(特に起動ボタンは用意していません。)

このようにマクロ名の選択画面が表示されるので、希望するマクロ名をクリックで反転させて「実行」をクリックします。ここでは「
GetMDBDataByADO」を選択して下さい。
次に開く
MDB(ACCDB)ファイルを選択して「開く」をクリックします。
先頭画面のような結果になりましたか?
(前提条件となる環境が整っていないとエラーになる場合もあります。)
では、コード内容を見てみましょう。
'***************************************************************************************************
' ADOでAccessデータベースからデータをシート上に展開する
'
' 作成者:井上治 URL:https://www.ne.jp/asahi/excel/inoue/ [Excelでお仕事!]
'***************************************************************************************************
' [参照設定]
' ・Windows Script Host Object Model
' ・Microsoft Active Data Objects 2.x Library
'***************************************************************************************************
' 変更日付 Rev 変更履歴内容---------------------------------------------------------------------->
' 16/12/31(1.0.0)新規作成
' 19/11/24(1.1.0)MDB/ACCDB兼用版として再作成
'***************************************************************************************************
Option Explicit
'===================================================================================================
Private Const g_cnsTitle = "ADOによるMDB(ACCDB)データ取得"
Private Const g_cnsFilter = "MDB(ACCDB)ファイル (*.mdb;*.accdb),*.mdb;*.accdb"
Private Const g_cnsADO_Connect1 = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source="""
'***************************************************************************************************
' ■■■ ADOによるデータ取得 ■■■
'***************************************************************************************************
'* 処理名 :GetMDBDataByADO
'* 機能 :ADOによるデータ取得
'---------------------------------------------------------------------------------------------------
'* 返り値 :(なし)
'* 引数 :(なし)
'---------------------------------------------------------------------------------------------------
'* 作成日 :2016年12月31日
'* 作成者 :井上 治
'* 更新日 :2019年11月24日
'* 更新者 :井上 治
'* 機能説明:「SampleCorp1.mdb(又はSampleCorp1.acccdb)」から配属データを取得してシートに展開
'* 注意事項:記述中核部分を明示するサンプルであるためエラー処理は行ないません
'***************************************************************************************************
Public Sub GetMDBDataByADO()
'-----------------------------------------------------------------------------------------------
Dim objWsh As WshShell ' WshShell
Dim dbCon As ADODB.Connection ' ADODB.Connection
Dim dbRes As ADODB.Recordset ' ADODB.Recordset
Dim objSh As Worksheet ' Excel.Worksheet
Dim lngRow As Long ' 行INDEX
Dim lngCol As Long ' 列INDEX
Dim vntFilename As Variant ' ファイル名(受取)
Dim strFilename As String ' フルパスファイル名
Dim strConnection As String ' 接続文字列
Dim strSQL As String ' SQL文編集WORK
Dim strToday As String ' SQL文本日編集WORK
Dim strCurrentPathSV As String ' カレントフォルダ(退避)
'-----------------------------------------------------------------------------------------------
' MDB(ACCDB)ファイル名の受け取り
Set objWsh = New WshShell ' WshShell
' 一旦、カレントフォルダを退避
strCurrentPathSV = objWsh.CurrentDirectory
' 本ブックのフォルダをカレントフォルダに設定
objWsh.CurrentDirectory = ThisWorkbook.Path
' 「開く」ダイアログでファイル名の受け取り
vntFilename = Application.GetOpenFilename(g_cnsFilter, , _
"配属データを参照するMDB(ACCDB)ファイルを指定して下さい。")
' カレントフォルダの復旧
objWsh.CurrentDirectory = strCurrentPathSV
Set objWsh = Nothing
' キャンセル確認
If VarType(vntFilename) = vbBoolean Then Exit Sub
strFilename = vntFilename
' 接続文字列の編集
strConnection = g_cnsADO_Connect1 & strFilename & """;"
'-----------------------------------------------------------------------------------------------
' 接続を確立する
Set dbCon = New ADODB.Connection
dbCon.Open strConnection
' クライアントカーソル設定(MDBでは関係ないかも)
dbCon.CursorLocation = adUseClient
' 参照SQL文の編集
strToday = "#" & Format(Date, "yyyy-MM-dd") & "#"
strSQL = "SELECT H.[BUSYO_CD]" ' (00)部署コード
strSQL = strSQL & ",B.[BUSYO_NM]" ' (01)部署名
strSQL = strSQL & ",H.[YAKU_CD]" ' (02)役職コード
strSQL = strSQL & ",Y.[YAKU_NM]" ' (03)役職名
strSQL = strSQL & ",H.[SCD]" ' (04)社員コード
strSQL = strSQL & ",S.[KANJI_SEI]+S.[KANJI_MEI]" ' (05)氏名(漢字)
strSQL = strSQL & ",S.[KANA_SEI]+S.[KANA_MEI]" ' (06)氏名(カナ)
strSQL = strSQL & ",S.[NYUSYA_YMD]" ' (07)入社日
strSQL = strSQL & ",S.[TAISYOKU_YMD]" ' (08)退職日
strSQL = strSQL & " FROM ((([MST_HAIZOKU] AS H"
strSQL = strSQL & " INNER JOIN [MST_SYAIN] AS S ON H.[SCD]=S.[SCD])"
strSQL = strSQL & " LEFT OUTER JOIN [MST_BUSYO] AS B ON H.[BUSYO_CD]=B.[BUSYO_CD])"
strSQL = strSQL & " LEFT OUTER JOIN [MST_YAKU] AS Y ON H.[YAKU_CD]=Y.[YAKU_CD])"
strSQL = strSQL & " WHERE S.[NYUSYA_YMD]<=" & strToday
strSQL = strSQL & " AND (S.[TAISYOKU_YMD] IS NULL OR S.[TAISYOKU_YMD]>" & strToday & ")"
strSQL = strSQL & " ORDER BY H.[BUSYO_CD],H.[YAKU_CD],H.[SCD];"
' 参照SQL文の発行
Set dbRes = New ADODB.Recordset
dbRes.Open strSQL, dbCon, adOpenKeyset, adLockReadOnly
' 画面描画更新停止
Call GP_StopSCUPD
' シート初期化
Set objSh = ThisWorkbook.Worksheets(1)
With objSh
If .FilterMode Then .ShowAllData
.Rows("2:" & .Rows.Count).ClearContents
lngRow = 1
' 先頭レコードからEOFまで繰り返す
Do Until dbRes.EOF
' 行を加算
lngRow = lngRow + 1
' 全列をシートに展開
For lngCol = 0 To 8
.Cells(lngRow, lngCol + 1).Value = dbRes.Fields(lngCol).Value
Next lngCol
' 次のレコードに移る
dbRes.MoveNext
Loop
End With
' レコードセット、データベースを閉じる
dbRes.Close
Set dbRes = Nothing
dbCon.Close
Set dbCon = Nothing
' 画面描画更新復帰
Call GP_StartSCUPD
End Sub
'------------------------------------------<< End of Source >>--------------------------------------
このように、
SELECT句のフィールド配置は配属一覧シートの列配置と合わせているので、セルに転記する部分もループ処理としています。
但し、レコードセットのフィールドインデックスはゼロ始まり、セルの列番号は
1始まりなので列番号側はインデックス値に
1を加えています。
上記のコードの内、「画面描画更新停止」「画面描画更新復帰」は「
ZZZ_Module」に共通処理として置いています。(
「DAOでデータを取得する。」の中で説明しています。)
※先頭のコメントに「参照設定:
Microsoft Active Data Object 2.x Library」と説明してありますが、このサンプルコードのように
ADOに関するデータ型を明示する場合は、
ADOを参照設定する必要があります。
VBE上の「ツール」メニューの「参照設定」で、
このように
ADOにチェックを付けて下さい。
古い
Officeを使い続けていることはセキュリティ上の問題もあるのであまりないとは思いますが、配布先の
Officeのバージョンがそろっていないようなケースでは「実行時バインド」という手もあります。
(現在では不要な配慮だと思われますが
)
上記のサンプルのように参照設定を行なわず、「
CreateObject関数」を使って「
ADODB.Connection」「
ADODB.Recordset」等のオブジェクトを実行時に生成する方法です。
おそらく、参照設定の方法より実行時にオブジェクトを生成する分が若干遅くなる要因にはなるのでしょうが、
ASPなどの
Webページや
VBSなどでは参照設定が元々使えずすべてこの「実行時バインド」によって動作しますから、この方法でも充分だと思います。
コード中の違う部分にはコメントを入れておきました。 先頭の画像クリックでダウンロードされる
ZIPファイルの中には「
MDB(ACCDB)配属一覧
(非参照設定版
).xlsm」が含まれています。
'***************************************************************************************************
' ADOでAccessデータベースからデータをシート上に展開する(非参照設定版)
'
' 作成者:井上治 URL:https://www.ne.jp/asahi/excel/inoue/ [Excelでお仕事!]
'***************************************************************************************************
' 変更日付 Rev 変更履歴内容---------------------------------------------------------------------->
' 16/12/31(1.0.0)新規作成
' 19/11/24(1.1.0)MDB/ACCDB兼用版として再作成
'***************************************************************************************************
Option Explicit
Private Const g_cnsTitle = "ADOによるMDB(ACCDB)データ取得"
Private Const g_cnsFilter = "MDB(ACCDB)ファイル (*.mdb;*.accdb),*.mdb;*.accdb"
Private Const g_cnsADO_Connect1 = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source="""
'**********↓↓↓非参照設定版はこれを追加します↓↓↓**********
Private Const adOpenKeyset = 1
Private Const adLockReadOnly = 1
Private Const adUseClient = 3
'**********↑↑↑非参照設定版はこれを追加します↑↑↑**********
'***************************************************************************************************
' ■■■ ADOによるデータ取得 ■■■
'***************************************************************************************************
'* 処理名 :GetMDBDataByADO
'* 機能 :ADOによるデータ取得
'---------------------------------------------------------------------------------------------------
'* 返り値 :(なし)
'* 引数 :(なし)
'---------------------------------------------------------------------------------------------------
'* 作成日 :2016年12月31日
'* 作成者 :井上 治
'* 更新日 :2019年11月24日
'* 更新者 :井上 治
'* 機能説明:「SampleCorp1.mdb(又はSampleCorp1.acccdb)」から配属データを取得してシートに展開
'* 注意事項:記述中核部分を明示するサンプルであるためエラー処理は行ないません
'***************************************************************************************************
Public Sub GetMDBDataByADO()
'-----------------------------------------------------------------------------------------------
'**********↓↓↓非参照設定版はこれを変更します↓↓↓**********
' Dim objWsh As WshShell ' WshShell
' Dim dbCon As ADODB.Connection ' ADODB.Connection
' Dim dbRes As ADODB.Recordset ' ADODB.Recordset
Dim objWsh As Object ' WshShell
Dim dbCon As Object ' ADODB.Connection
Dim dbRes As Object ' ADODB.Recordset
'**********↑↑↑非参照設定版はこれを変更します↑↑↑**********
Dim objSh As Worksheet ' Excel.Worksheet
Dim lngRow As Long ' 行INDEX
Dim lngCol As Long ' 列INDEX
Dim vntFilename As Variant ' ファイル名(受取)
Dim strFilename As String ' フルパスファイル名
Dim strConnection As String ' 接続文字列
Dim strSQL As String ' SQL文編集WORK
Dim strToday As String ' SQL文本日編集WORK
Dim strCurrentPathSV As String ' カレントフォルダ(退避)
'-----------------------------------------------------------------------------------------------
' MDB(ACCDB)ファイル名の受け取り
'**********↓↓↓参照設定版とはここが違います↓↓↓**********
'Set objWsh = New WshShell
Set objWsh = CreateObject("WScript.Shell")
'**********↑↑↑参照設定版とはここが違います↑↑↑**********
' 一旦、カレントフォルダを退避
strCurrentPathSV = objWsh.CurrentDirectory
' 本ブックのフォルダをカレントフォルダに設定
objWsh.CurrentDirectory = ThisWorkbook.Path
' 「開く」ダイアログでファイル名の受け取り
vntFilename = Application.GetOpenFilename(g_cnsFilter, , _
"配属データを参照するMDB(ACCDB)ファイルを指定して下さい。")
' カレントフォルダの復旧
objWsh.CurrentDirectory = strCurrentPathSV
Set objWsh = Nothing
' キャンセル確認
If VarType(vntFilename) = vbBoolean Then Exit Sub
strFilename = vntFilename
' 接続文字列の編集
strConnection = g_cnsADO_Connect1 & strFilename & """;"
'-----------------------------------------------------------------------------------------------
' 接続を確立する
'**********↓↓↓参照設定版とはここが違います↓↓↓**********
' Set dbCon = New ADODB.Connection
Set dbCon = CreateObject("ADODB.Connection")
'**********↑↑↑参照設定版とはここが違います↑↑↑**********
dbCon.Open strConnection
' クライアントカーソル設定(MDBでは関係ないかも)
dbCon.CursorLocation = adUseClient
' 参照SQL文の編集
strToday = "#" & Format(Date, "yyyy-MM-dd") & "#"
strSQL = "SELECT H.[BUSYO_CD]" ' (00)部署コード
strSQL = strSQL & ",B.[BUSYO_NM]" ' (01)部署名
strSQL = strSQL & ",H.[YAKU_CD]" ' (02)役職コード
strSQL = strSQL & ",Y.[YAKU_NM]" ' (03)役職名
strSQL = strSQL & ",H.[SCD]" ' (04)社員コード
strSQL = strSQL & ",S.[KANJI_SEI]+S.[KANJI_MEI]" ' (05)氏名(漢字)
strSQL = strSQL & ",S.[KANA_SEI]+S.[KANA_MEI]" ' (06)氏名(カナ)
strSQL = strSQL & ",S.[NYUSYA_YMD]" ' (07)入社日
strSQL = strSQL & ",S.[TAISYOKU_YMD]" ' (08)退職日
strSQL = strSQL & " FROM ((([MST_HAIZOKU] AS H"
strSQL = strSQL & " INNER JOIN [MST_SYAIN] AS S ON H.[SCD]=S.[SCD])"
strSQL = strSQL & " LEFT OUTER JOIN [MST_BUSYO] AS B ON H.[BUSYO_CD]=B.[BUSYO_CD])"
strSQL = strSQL & " LEFT OUTER JOIN [MST_YAKU] AS Y ON H.[YAKU_CD]=Y.[YAKU_CD])"
strSQL = strSQL & " WHERE S.[NYUSYA_YMD]<=" & strToday
strSQL = strSQL & " AND (S.[TAISYOKU_YMD] IS NULL OR S.[TAISYOKU_YMD]>" & strToday & ")"
strSQL = strSQL & " ORDER BY H.[BUSYO_CD],H.[YAKU_CD],H.[SCD];"
' 参照SQL文の発行
'**********↓↓↓参照設定版とはここが違います↓↓↓**********
' Set dbRes = New ADODB.Recordset
Set dbRes = CreateObject("ADODB.Recordset")
'**********↑↑↑参照設定版とはここが違います↑↑↑**********
dbRes.Open strSQL, dbCon, adOpenKeyset, adLockReadOnly
' 画面描画更新停止
Call GP_StopSCUPD
' シート初期化
Set objSh = ThisWorkbook.Worksheets(1)
With objSh
If .FilterMode Then .ShowAllData
.Rows("2:" & .Rows.Count).ClearContents
lngRow = 1
' 先頭レコードからEOFまで繰り返す
Do Until dbRes.EOF
' 行を加算
lngRow = lngRow + 1
' 全列をシートに展開
For lngCol = 0 To 8
.Cells(lngRow, lngCol + 1).Value = dbRes.Fields(lngCol).Value
Next lngCol
' 次のレコードに移る
dbRes.MoveNext
Loop
End With
' レコードセット、データベースを閉じる
dbRes.Close
Set dbRes = Nothing
dbCon.Close
Set dbCon = Nothing
' 画面描画更新復帰
Call GP_StartSCUPD
End Sub
'------------------------------------------<< End of Source >>--------------------------------------
この方法では、「
dbCon」「
dbRes」などはすべて「
Object」で宣言されています。(実際は「
Variant」でも構いません。)
つまり、「
Setステートメント」でオブジェクトの参照を与えられるまでは「何だか分からない」ことになります。
ですから、コードの作成ではプロパティの自動メンバ表示もされないし、コンパイルでの不具合摘出もできません。また、ライブラリが提供する名前付き定数も利用できないので、ここでも「
adOpenKeyset」「
adLockReadOnly」はコード内で定数宣言させています。
これらのことから、最終的に「実行時バインド」の方法を採用するとしても、マクロ作成の段階では一旦、「参照設定」を行なってやる方がはるかに効率的だといえると思います。いきなり「実行時バインド」で記述して動かせるのはかなりのベテランでなければならないでしょう。