Accessファイルチェック - toolstorage

Accessファイルチェック

• ソース

Option Compare Database
Option Explicit

' ACC_CheckAccessFile
' VBAでMDBやACCDBを操作する際に行う簡単なチェックを行う
' MDB・ACCDBのファイルにアクセスする前の確認項目

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 result As Boolean
    
    ' 1.返却値の初期化
    result = False
    
    ' 2.Accessのバージョンに対し、有効なファイルかどうか確認
    If GetAccessFilePattern(iFilePath) > 0 Then
        result = True
    End If
    IsAccessDBFile = result
End Function


' GetAccessFilePattern
' 指定のファイル（含フルパス）が使用しているAccessのバージョンで有効なDBファイルかを確認する
' また、有効であった場合、そのパターンを判別可能な値を返却する
' ①Accessのバージョンが2007以降では拡張子が「mdb」の実在するファイルのみ有効（戻り値は11）
' ②Accessのバージョンが2007以降では拡張子が「accdb」の実在するファイルのみ有効（戻り値は12）
' ③Accessのバージョンが2003以前では拡張子が「mdb」の実在するファイルのみ有効（戻り値は1）
' 上記①～③以外はすべて無効なファイルとする
' その他のAccessに関連する拡張子のファイルは除外とします
' 引数：あり
' iFilePath ：String    ：ファイル（含ファイルまでのフルパス）
' 戻り値：あり
' Long   ：確認結果
Public Function GetAccessFilePattern(ByVal iFilePath As String) As Long
    Dim file As String
    Dim versionNumber As Double
    Dim resultLng As Long
    
    ' 1.返却値の初期化
    resultLng = 0
    
    ' 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" Then
                ' 拡張子が「mdb」場合、返却値をTRUEにする
                resultLng = 11
            ElseIf Right(file, 6) = ".accdb" Then
                ' 拡張子が「mdb」または「accdb」の場合、返却値をTRUEにする
                resultLng = 12
            End If
            
        Else
        ' B.Accessのバージョンが2003以前の場合
        
            If Right(file, 4) = ".mdb" Then
                ' 拡張子が「mdb」の場合、返却値をTRUEにする
                resultLng = 1
            End If
        End If
        
    End If
    
    GetAccessFilePattern = resultLng
End Function

トップ