DAO DAOを使いMDBファイルを開けてデータを読む(ExcelVBA)
※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。
※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。
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 |