DAO DAOを使いMDBファイルを開けてデータを読む(ExcelVBA)

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit


Sub DAO_MDB_OpenRead()
'***************************************************
'DAOを使いMDBファイルを開けてデータを読む(ExcelVBA)
'***************************************************
'[Microsoft DAO 3.6 Object Library]参照設定

Dim objDtbs As DAO.Database
Dim objRcrd As DAO.Recordset
Dim strFilePath As String
Dim strFileName As String
Dim strTblName As String
Dim strFieldName() As String
Dim lngFldCnt As Long
Dim lngMvRcrd As Long
Dim strMv As String
Dim i As Long

strFilePath = ThisWorkbook.Path     'ファイルのパス
strFileName = "KEN_ALL.mdb"         'ファイル名
strTblName = "KEN_ALL"              'テーブル名

'【エラートラップ】
On Error GoTo MDB_OpenRead:

'【データベースを開く】
Set objDtbs = OpenDatabase(strFilePath & "\" & strFileName)
'【テーブルを開く】
Set objRcrd = objDtbs.OpenRecordset(strTblName)

With objRcrd
'【フィールド数カウント】
    For i = 1 To .Fields.Count
        lngFldCnt = lngFldCnt + 1
        ReDim Preserve strFieldName(lngFldCnt) As String
'【フィールド名取得】
        strFieldName(lngFldCnt) = .Fields(i - 1).Name
    Next
End With

'【先頭のレコードに移動】
objRcrd.MoveFirst

Do Until objRcrd.EOF

    lngMvRcrd = lngMvRcrd + 1

    strMv = ""
'【レコードの値を取得】
        For i = 1 To lngFldCnt
            strMv = strMv & i & vbTab & strFieldName(i) & vbTab & vbTab & objRcrd(strFieldName(i)).Value & vbCr
        Next i

    If MsgBox(strMv, vbOKCancel, "レコード" & lngMvRcrd) = vbCancel Then
        GoTo OpenRead_END:
    End If
'【次のレコードに移動】
    objRcrd.MoveNext
Loop

OpenRead_END:

'【データベースを閉じる】
objDtbs.Close

Set objRcrd = Nothing
Set objDtbs = Nothing

Exit Sub

'【エラートラップ】
MDB_OpenRead:

MsgBox "予期せぬエラーが発生しました。" & vbCrLf & Err.Description, vbCritical, "CreateDatabase"

End Sub

 

2000年01月01日|[VBサンプルコード]:[DAO]