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

「Accessファイルチェック」(2013/06/09 (日) 00:39:39) の最新版変更点

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

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

***Accessファイルチェック
- ソース

 Private filename As String
 Private filepath As String
 
 Private Sub class_initialize()
     filename = ""
     filepath = ""
 End Sub
 
 Public Function GetFileName() As String
     GetFileName = filename
 End Function
 
 Public Function GetFilePath() As String
     GetFilePath = filepath
 End Function
 
 Public Function SetFileName(ByVal iStr As String)
     filename = iStr
 End Function
 
 Public Function SetFilePath(ByVal iStr As String)
     filepath = iStr
 End Function
 
 
 

[[トップ]]


　

***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
 
 
 

[[トップ]]