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 >>--------------------------------------
上記のコードの内、「画面描画更新停止」「画面描画更新復帰」は「ZZZ_Module」に共通処理として置いています。(「DAOでデータを取得する。」の中で説明しています。)
※先頭のコメントに「参照設定：Microsoft Active Data Object 2.x Library」と説明してありますが、このサンプルコードのようにADOに関するデータ型を明示する場合は、ADOを参照設定する必要があります。
VBE上の「ツール」メニューの「参照設定」で、
このようにADOにチェックを付けて下さい。