DAOはAccessの標準のデータベースエンジンであり、Accessがインストールされていない環境でもテーブルに関する操作は可能です。
(画像をクリックすると、このページのサンプルがダウンロードできます)
「
MDB(ACCDB)配属一覧
.xlsm」を開いて下さい。
このようにマクロを起動させて下さい。(特に起動ボタンは用意していません。)
このようにマクロ名の選択画面が表示されるので、希望するマクロ名をクリックで反転させて「実行」をクリックします。ここでは「
GetMDBDataByDAO」を選択して下さい。
次に開く
MDB(ACCDB)ファイルを選択して「開く」をクリックします。
先頭画面のような結果になりましたか?
(前提条件となる環境が整っていないとエラーになる場合もあります。)
では、コード内容を見てみましょう。「
DAO_Module」です。
'***************************************************************************************************
' DAOでAccessデータベースからデータをシート上に展開する
'
' 作成者:井上治 URL:https://www.ne.jp/asahi/excel/inoue/ [Excelでお仕事!]
'***************************************************************************************************
' [参照設定]
' ・Windows Script Host Object Model
' ・Microsoft Office 1x.0 Access database engine Object Library
'***************************************************************************************************
' 変更日付 Rev 変更履歴内容---------------------------------------------------------------------->
' 16/12/31(1.0.0)新規作成
' 19/11/24(1.1.0)MDB/ACCDB兼用版として再作成
'***************************************************************************************************
Option Explicit
'===================================================================================================
Private Const g_cnsTitle = "DAOによるMDB(ACCDB)データ取得"
Private Const g_cnsFilter = "MDB(ACCDB)ファイル (*.mdb;*.accdb),*.mdb;*.accdb"
'***************************************************************************************************
' ■■■ DAOによるデータ取得 ■■■
'***************************************************************************************************
'* 処理名 :GetMDBDataByDAO
'* 機能 :DAOによるデータ取得
'---------------------------------------------------------------------------------------------------
'* 返り値 :(なし)
'* 引数 :(なし)
'---------------------------------------------------------------------------------------------------
'* 作成日 :2016年12月31日
'* 作成者 :井上 治
'* 更新日 :2019年11月24日
'* 更新者 :井上 治
'* 機能説明:「SampleCorp1.mdb(又はSampleCorp1.acccdb)」から配属データを取得してシートに展開
'* 注意事項:記述中核部分を明示するサンプルであるためエラー処理は行ないません
'***************************************************************************************************
Public Sub GetMDBDataByDAO()
'-----------------------------------------------------------------------------------------------
Dim objWsh As WshShell ' WshShell
Dim dbWS As DAO.Workspace ' DAO.Workspace
Dim dbWB As DAO.Database ' DAO.Database
Dim dbRes As DAO.Recordset ' DAO.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 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
'-----------------------------------------------------------------------------------------------
' ワークスペースを定義
Set dbWS = DBEngine.Workspaces(0)
' データベースを開く
Set dbWB = dbWS.OpenDatabase(strFilename)
' 参照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];"
' レコードセットを取得
Set dbRes = dbWB.OpenRecordset(strSQL, dbOpenDynaset)
' 画面描画更新停止
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(lngCol).Value
Next lngCol
' 次のレコードに移る
dbRes.MoveNext
Loop
End With
' レコードセット、データベースを閉じる
dbRes.Close
Set dbRes = Nothing
dbWB.Close
Set dbWB = Nothing
dbWS.Close
Set dbWS = Nothing
' 画面描画更新復帰
Call GP_StartSCUPD
End Sub
'------------------------------------------<< End of Source >>--------------------------------------
このように、
SELECT句のフィールド配置は配属一覧シートの列配置と合わせているので、セルに転記する部分もループ処理としています。
但し、レコードセットのフィールドインデックスはゼロ始まり、セルの列番号は
1始まりなので列番号側はインデックス値に
1を加えています。
上記のコードの内、「画面描画更新停止」「画面描画更新復帰」は「
ZZZ_Module」に共通処理として置いています。
'*******************************************************************************
' Accessデータベースからデータをシート上に展開する(共通部品)
'
' 作成者:井上治 URL:https://www.ne.jp/asahi/excel/inoue/ [Excelでお仕事!]
'*******************************************************************************
Option Explicit
Option Private Module
'*******************************************************************************
' 画面描画更新停止
'*******************************************************************************
Public Sub GP_StopSCUPD()
With Application
.ScreenUpdating = False
' .EnableCancelKey = xlDisabled
.Calculation = xlCalculationManual
' .Interactive = False
' .Cursor = xlWait
.EnableEvents = False
End With
End Sub
'*******************************************************************************
' 画面描画更新復帰
'*******************************************************************************
Public Sub GP_StartSCUPD()
With Application
If .Calculation <> xlCalculationAutomatic Then
.Calculation = xlCalculationAutomatic
End If
.Cursor = xlDefault
.EnableCancelKey = xlInterrupt
.EnableEvents = True
.Interactive = True
.StatusBar = False
.ScreenUpdating = True
End With
End Sub
'-----------------------------<< End of Source >>-------------------------------
内容としては、画面描画停止、自動計算停止、イベント発生抑制という処理速度に関するものの他、マウスカーソル形状、
Escキー動作、
UI制御などです。この内、
Escキー動作、
UI制御については、エラー処理などをうまく処理しないと
Excelの状態が元に戻らなくなるため、サンプル記述ではコメントとしています。
※先頭のコメントに「参照設定:
Microsoft Office 1x.0 Access database engine Object Library」と説明してありますが、このサンプルコードのように
DAOに関するデータ型を明示する場合は参照設定する必要があります。
VBE上の「ツール」メニューの「参照設定」で、
このように「
Microsoft Office 1x.0 Access database engine Object Library」にチェックを付けて下さい。
数字の部分は
Officeのバージョンにより換わります。
Officeが
32ビット版の場合は「
Microsoft DAO 3.6 Object Library」でも同じ動作になります。
実行時バインドを使う場合でも、最初はこのように「参照設定」を使って十分に動作を確認した上で切り替えるようにして下さい。