※上記の広告は60日以上更新のないWIKIに表示されています。更新することで広告が下部へ移動します。

Accessファイルチェッククラス

機能

  • 指定ファイルが使用中のAccessで操作可能なファイルかを確認する
  • 指定MDBに指定の名前のテーブルが存在しているか確認する
  • 指定MDBの指定の名前のテーブルに1件以上レコードが存在しているかを確認する
  • 指定MDBに指定の名前のクエリが存在しているか確認する

メモ

このクラスのプロシージャは、以下の標準モジュールのプロシージャのセットです。


ソース

Option Compare Database
Option Explicit

' ACC_CheckAccessFile
' VBAでMDBやACCDBを操作する際に行う簡単なチェックを行う
' 実行環境にはDAOの参照設定が必要です

Private Sub class_initialize()
    ' なにもしません
End Sub

' IsAccessDBFile
' 指定のファイル(含フルパス)が使用しているAccessのバージョンで開くことが可能なDBファイルかを確認する
' ①Accessのバージョンが2007以降では拡張子が「mdb」または「accdb」の実在するファイルのみTRUE
' ②Accessのバージョンが2003以前では拡張子が「mdb」の実在するファイルのみTRUE
' 上記①②以外はすべてFALSE
' その他のAccessに関連する拡張子のファイルは除外とします
' 引数:あり
' iFilePath :String    :ファイル(含ファイルまでのフルパス)
' 戻り値:あり
' Boolean   :確認結果
Public Function IsAccessDBFile(ByVal iFilePath As String) As Boolean
    Dim file As String
    Dim versionNumber As Double
    Dim result As Boolean
    
    ' 1.返却値の初期化
    result = False
    
    ' 2.Accessのバージョンの取得
    versionNumber = Application.Version
    
    ' 3.対象ファイルの実在確認
    file = Dir(iFilePath, vbNormal)
    
    If file <> "" And Len(iFilePath) > 0 Then
        ' 4.ファイルが実在する場合バージョンにより判断方法を分ける
        
        If versionNumber > 11 Then
        ' A.Accessのバージョンが2007以降の場合
            
            If Right(file, 4) = ".mdb" Or Right(file, 6) = ".accdb" Then
                ' 拡張子が「mdb」または「accdb」の場合、返却値をTRUEにする
                result = True
            End If
            
        Else
        ' B.Accessのバージョンが2003以前の場合
        
            If Right(file, 4) = ".mdb" Then
                ' 拡張子が「mdb」の場合、返却値をTRUEにする
                result = True
            End If
        End If
        
    End If
    
    IsAccessDBFile = result
End Function

' HasSelectedTable
' 指定DBに指定テーブルが存在しているかを確認する
' 引数:あり
' iDB   : DAO.Database    :検索先のDB
' iSelectedTableName    : String  :検索対象のテーブル名
' 戻り値:あり
' Boolean   : 検索対象のテーブルの有無(テーブルが存在していた場合TRUE)
Public Function HasSelectedTable(ByVal iDB As DAO.Database, ByVal iSelectedTableName As String) As Boolean
    Dim dbTblDef As DAO.TableDef
    Dim result As Boolean
    
    ' 1.返却値の初期化
    result = False
    
    ' 2.指定DBのすべてのテーブルに対し処理を行う
    For Each dbTblDef In iDB.TableDefs
        ' A.検索対象のテーブルが存在していれば、返却値をTRUEにする
        If dbTblDef.Name = iSelectedTableName Then
            result = True
            Exit For
        End If
    Next
    
    HasSelectedTable = result
End Function


' HasRecordInSelectedTable
' 指定DBの指定テーブルがレコードを1件以上保持しているかを確認する
' 事前に指定テーブル自体の有無は確認しておくこと
' 引数:あり
' iDB   : DAO.Database    :検索先のDB
' iSelectedTableName    : String  :検索対象のテーブル名
' 戻り値:あり
' Boolean   : 検索対象のレコードの有無(レコードが存在していた場合TRUE)
Public Function HasRecordInSelectedTable(ByVal iDB As DAO.Database, ByVal iSelectedTableName As String) As Boolean
    Dim rsObj As DAO.Recordset
    Dim result As Boolean
    
    ' 1.返却値の初期化
    result = False
    
    ' 2.確認時点の指定テーブルのレコードを取得
    Set rsObj = iDB.OpenRecordset(iSelectedTableName, dbOpenSnapshot)
    
    If rsObj.RecordCount > 0 Then
        '3.レコード数が1件以上の場合、返却値をTRUEにする
        result = True
    End If
    
    Set rsObj = Nothing
    
    HasRecordInSelectedTable = result
End Function

' HasSelectedQuery
' 指定DBに指定クエリが存在しているかを確認する
' 引数:あり
' iDB   : DAO.Database    :検索先のDB
' iSelectedQueryName    : String  :検索対象のクエリ名
' 戻り値:あり
' Boolean   : 検索対象のクエリの有無(クエリが存在していた場合TRUE)
Public Function HasSelectedQuery(ByVal iDB As DAO.Database, ByVal iSelectedQueryName As String) As Boolean
    Dim dbQueryDef As DAO.QueryDef
    Dim result As Boolean
    
    ' 1.返却値の初期化
    result = False
    
    ' 2.指定DBのすべてのテーブルに対し処理を行う
    For Each dbQueryDef In iDB.QueryDefs
        ' 3.検索対象のテーブルが存在していれば、返却値をTRUEにする
        If dbQueryDef.Name = iSelectedQueryName Then
            result = True
            Exit For
        End If
    Next
    
    HasSelectedQuery = result
End Function

2013/05/12 更新
2013/05/15 全面改訂