「Accessファイルチェッククラス」の編集履歴（バックアップ）一覧はこちら

「Accessファイルチェッククラス」(2013/05/16 (木) 01:43:20) の最新版変更点

追加された行は緑色になります。

削除された行は赤色になります。

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

***メモ
このクラスのプロシージャは、以下の標準モジュールのプロシージャのセットです。
- [[Accessファイル操作可否]]
- [[指定テーブルの有無]]
- [[指定テーブルのレコードの有無]]
- [[指定クエリの有無]]


*** ソース
 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 全面改訂

[[トップ]]

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

***メモ
このクラスのプロシージャは、以下の標準モジュールのプロシージャのセットです。
- [[Accessファイル操作可否]]
- [[指定テーブルの有無]]
- [[指定テーブルのレコードの有無]]
- [[指定クエリの有無]]


*** ソース
 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 全面改訂

[[TOOL_テキストファイル情報収集]]

[[トップ]]