VBScript でMS Access の mdb accdbのVersionを判定する

TsWareさんのコードをVBSにするとともに、Access2016以降に対応versionを作成

https://tsware.jp/tips/tips_038.htm
これをVBSに変えるとともに、mdbとaccdbの両方に対応。Access2016は BigIntを使用するとVersionがあがるという問題に対処しました。
このためAccess2016以降がインストールされている場合とAccess2013-Access2007までと異なります。
Access2000からAccess2003用はtswareをごらんください。

AccessのCurrentのVersion

https://support.microsoft.com/ja-jp/help/2798395/access-incorrect-current-version-registry-key
同時に複数の場合不明ではなく、同時にインストールした場合を想定してこのレジストリの場所で決めているものと思われる。
Access2016とAccess 2007 が同居し、このためaccdbをAccess2007で開いて判定する場合、結果が違う可能性がある。極力新しいバージョンで行うため、レジストリを確認する必要がある。
過去記事で
https://qiita.com/Q11Q/items/13896d71af845dc01377
これからするとversionは後付けの属性で、これを付加してあるファイルはAccess2.0形式でも変換ができるようになるのはこのためであると考えられる。

32bit強制起動の弱点

ドラッグアンドドロップ起動がどうも使えないようなので、冒頭のConstのファイル名を変更しなければならない。
どうも強制起動するときに抜けるようだ。

Accessが起動したときに1000ミリ秒以上開けないとエラーになる

当方のPCは最低スペックなので、1000あれば十分とも思われるが、足りない場合は500単位であげてください。

Accdbの判定にはAccess 2007 以降が必須です

PCにインストールされていないとaccdbが判定できません。
もしない場合には64bitの方でDao.120を使います。
つまり、一つのScriptで解決できません。

VBScriptのコード

Access 2007 - Access 2013

ShowMsAccess_MDBFileVersionIs.vbs

Option Explicit
'For Access 2007 - Access 2013
Const testmdbFileName = "C:\hoge\Database10.accdb" 'mdb / accdb full file Name
'これはAccess 2016以降で起動することを前提としています。上記定数に調べたいファイル名をいれてください。
'なおこのVBScriptに限らずVBScriptをUTF-8形式で保存するとファイル名が文字化けするなどエラーになります。ANSI形式で保存してください。
'ファイル名に環境依存文字がある場合は関数を用いて後に付け加えるなど工夫してください。
'こちらも2016以降でも動きます。しかしBigint（大きい数字）を使用すると、Access2013以前のバージョンは開けないためエラーになります

Const SleepTime = 1000 'accdbの場合、Accessを起動するのに1000(＝1秒)取っています。足りずにエラーを起こす場合は500づつ増やしてください。
'32bit 強制起動
'http://scripting.cocolog-nifty.com/blog/2011/02/wsh6432bit-b32d.html

If InStr(LCase(WScript.FullName),"system32") Then 
If CreateObject("Scripting.FileSystemObject").FileExists(Replace(LCase(WScript.FullName),"system32","syswow64")) Then
  CreateObject("WScript.Shell").Run """" & Replace(LCase(WScript.FullName),"system32","syswow64") & """ """ & WScript.ScriptFullName & """"
  WScript.Quit
End If
End If
Const dbAttachedODBC=&H20000000,dbAttachedTable=&H40000000,dbAttachExclusive=&H10000,dbHiddenObject=1,dbSystemObject=&H80000002
Const dbVersion20=16,dbVersion10=1,dbVersion120=128,dbVersion11=8,dbEncrypt=2,dbDecrypt=4
Const dbVersion30 =32
Const dbVersion40 =64
'LanguageConstants 列挙 (DAO)(https://msdn.microsoft.com/ja-jp/library/office/ff821047.aspx)
Const dbLangGeneral = ";LANGID=0x0409;CP=1252;COUNTRY=0" '英語、ドイツ語、フランス語、ポルトガル語、イタリア語、および現代スペイン語
Const dbLangJapanese = ";LANGID=0x0411;CP=932;COUNTRY=0"
'LockTypeEnum 列挙 (DAO)
Const dbOptimistic=3,dbOptimisticBatch=5,dbPessimistic=2,dbOptimisticValue=1
'WorkspaceTypeEnum 列挙 (DAO)
Const dbUseJet = 2
'''''''''Access.Apllicastin Syscmd AcSysCmdAction 列挙
    Const acSysCmdClearStatus = 5
    Const acSysCmdAccessDir = 9
    Const acSysCmdGetWorkgroupFile = 13
    Const acSysCmdIniFile = 8
    Const acSysCmdProfile = 12
    Const acSysCmdRuntime = 6
    Const acSysCmdAccessVer = 7
'ADO Data Type
Const adBigInt=2,adBinary=128,adBoolean=11,adBSTR=8,adChar=129,adCurrency=6,adDate=7,adFileTime=64,adGUID=72,adInteger=3,adLongVarChar=201,adDBDate=133,adDBTime=134,adDBTimeStamp=135,adDecimal=4,adDouble=5
'Ado PositionEnum
Const adPosEOF=-3,adPosBOF=-2,adPosUnknown=-1 
'ADO CursorLocationEnum
Const adUseClient=3
'ADO CursorType
Const adOpenDynamic=2,adOpenForwardOnly =0,adOpenKeySet=1,adOpenStatic=3
Dim FSO : Set fso = CreateObject("Scripting.Filesystemobject")
Dim oFile : Set oFile = fso.getfile(testmdbFileName)
Dim StrBuf
If Lcase(fso.getextensionname(oFile)) = "mdb" then
Wscript.Echo GetAccVer(oFile)
Else
Wscript.Echo fso.getextensionname(oFile)
If LCase(fso.getextensionname(oFile))= "accdb" then
With CreateObject("Access.Application")
.Visible = true
StrBuf = Cstr(oFile.Path)
Set oFile = Nothing
Set fso = Nothing
Wscript.Sleep SleepTime
On Error Resume Next
.OpenCurrentDataBase StrBuf,False ,""
Wscript.Sleep SleepTime
If Err.Number <> 0 Then
Wscript.Quit
End if
Wscript.echo "In " & .SysCmd(acSysCmdAccessDir) & " Access 2000 Later Version " & _
       .Version & " is istalled." 
Select Case .CurrentDb.Version
Case "12.0"
WScript.Echo "accdb file Version 12.0 is Access 2007"
Case "14.0"
WScript.Echo "accdb file Version 14.0 is Access 2010"
Case "15.0"
WScript.Echo "accdb file Version 15.0 is Access 2013"
Case "16.0"
WScript.Echo "accdb file Version 16.0 is Access 2016 or Access 2019"
Case Else
WScript.Echo "accdb file Version Unknown maybe Access 2019 after Latest Version."
End Select
       .CloseCurrentDatabase
       .Quit
End With
End IF
End if
Wscript.Quit
' /////////////////////////////////// '
'/////// Function   //////////////// '
' /////////////////////////////////// '
Function GetAccVer(strMDBPath)' As String) 'As String
  Dim acApp, cDB
  Dim dbs
  Dim dbe :set dbe = CreateObject("DAO.DBEngine.36")  '[DBEngine オブジェクト (DAO)](https://docs.microsoft.com/ja-jp/office/client-developer/access/desktop-database-reference/dbengine-object-dao)
  Set dbs = Dbe(0).OpenDatabase(strMDBPath) '[Workspace.OpenDatabase メソッド (DAO)](https://docs.microsoft.com/ja-jp/office/client-developer/access/desktop-database-reference/workspace-opendatabase-method-dao)
  'Wscript.Echo dbs.version & "this"
  Select Case dbs.Version '[Version プロパティ (DAO)](https://docs.microsoft.com/ja-jp/office/client-developer/access/desktop-database-reference/database-version-property-dao)
    Case "1.1"
      GetAccVer = "Access1.1"
      dbs.Close
    Case "2.0"
      GetAccVer = "Access2.0"
    Case "3.0"
      If Left(dbs.Properties("AccessVersion"), 2) = "06" Then
        GetAccVer = "Access95"
      Else
        GetAccVer = "Access97"
      End If
      dbs.Close
    Case "4.0"
        GetAccVer = "Access2000 : AccessVersion" &  Left(dbs.Properties("AccessVersion"), 2)
        dbs.close
    Case Else
       Set Dbs = Nothing
       Do Until dbs is nothing
       On Error Resume Next
       Wscript.Sleep 500
       If Err.Number<> 0 then Err.Clear : Exit Do
       Loop

  End Select

End Function

Access2007 - Access 2016 Later BigInt mdbの区分詳細化版

Access 2007 以降で
mdb 2000
mdb 2000-2003形式で保存できますが、何が違うのか。
Versionは同じ4.0ですがAccess Version が　08.50と09.50の違いがあります。

Option Explicit
' /////// For Access 2016 Later Version //////////// '
Const testmdbFileName = "C:\hoge\Database10.accdb" 'mdb / accdb full file Name

'これはAccess 2016以降で起動することを前提としています。上記定数に調べたいファイル名をいれてください。
'なおこのVBScriptに限らずVBScriptをUTF-8形式で保存するとファイル名が文字化けするなどエラーになります。ANSI形式で保存してください。
'ファイル名に環境依存文字がある場合は関数を用いて後に付け加えるなど工夫してください。
Const SleepTime = 1000 'accdbの場合、Accessを起動するのに1000(＝1秒)取っています。足りずにエラーを起こす場合は500づつ増やしてください。
'32bit 強制起動
'http://scripting.cocolog-nifty.com/blog/2011/02/wsh6432bit-b32d.html
If InStr(LCase(WScript.FullName),"system32") Then 
If CreateObject("Scripting.FileSystemObject").FileExists(Replace(LCase(WScript.FullName),"system32","syswow64")) Then
  CreateObject("WScript.Shell").Run """" & Replace(LCase(WScript.FullName),"system32","syswow64") & """ """ & WScript.ScriptFullName & """"
  WScript.Quit
End If
End If
' //////////////////////////////// //////////////// '
'/////// Const / Enumuration Block //////////////// '
' ///////////////////////////////////////////////// '
    Const dbAttachedODBC=&H20000000,dbAttachedTable=&H40000000,dbAttachExclusive=&H10000,dbHiddenObject=1,dbSystemObject=&H80000002
    Const dbVersion20=16,dbVersion10=1,dbVersion120=128,dbVersion11=8,dbEncrypt=2,dbDecrypt=4
    Const dbVersion30 =32
    Const dbVersion40 =64
'LanguageConstants 列挙 (DAO)(https://msdn.microsoft.com/ja-jp/library/office/ff821047.aspx)
    Const dbLangGeneral = ";LANGID=0x0409;CP=1252;COUNTRY=0" '英語、ドイツ語、フランス語、ポルトガル語、イタリア語、および現代スペイン語
    Const dbLangJapanese = ";LANGID=0x0411;CP=932;COUNTRY=0"
'LockTypeEnum 列挙 (DAO)
    Const dbOptimistic=3,dbOptimisticBatch=5,dbPessimistic=2,dbOptimisticValue=1
'WorkspaceTypeEnum 列挙 (DAO)
    Const dbUseJet = 2
'''''''''Access.Apllicastin Syscmd AcSysCmdAction 列挙
    Const acSysCmdClearStatus = 5
    Const acSysCmdAccessDir = 9
    Const acSysCmdGetWorkgroupFile = 13
    Const acSysCmdIniFile = 8
    Const acSysCmdProfile = 12
    Const acSysCmdRuntime = 6
    Const acSysCmdAccessVer = 7
'ADO Data Type
    Const adBigInt=2,adBinary=128,adBoolean=11,adBSTR=8,adChar=129,adCurrency=6,adDate=7,adFileTime=64,adGUID=72,adInteger=3,adLongVarChar=201,adDBDate=133,adDBTime=134,adDBTimeStamp=135,adDecimal=4,adDouble=5
'Ado PositionEnum
    Const adPosEOF=-3,adPosBOF=-2,adPosUnknown=-1 
'ADO CursorLocationEnum
    Const adUseClient=3
'ADO CursorType
    Const adOpenDynamic=2,adOpenForwardOnly =0,adOpenKeySet=1,adOpenStatic=3

' /////////////////////////////////// '
'/////// Main Block //////////////// '
' /////////////////////////////////// '

Dim FSO, oFile : Set FSO = CreateObject("Scripting.Filesystemobject")
If FSO.FileExists(testmdbFileName) Then
  Set oFile = FSO.GetFile(testmdbFileName)
Else
  Wscript.Echo testmdbFileName &  " File Not Found"
  Wscript.Quit
End If
Dim StrBuf
Dim sngNum
Dim Rex,oMatchCollection , oMatch,oSubMatches , iMatch : Set Rex = CreateObject("VBScript.RegExp")
Rex.Global= True : Rex.MultiLine = False :Rex.IgnoreCase = False : Rex.Pattern = ".\(x86\)."
If LCase(fso.getextensionname(oFile)) = "mdb" then
WScript.Echo GetAccVer(oFile) 
ElseIf LCase(FSO.GetExtensionName(oFile))= "accdb" then

With CreateObject("Access.Application")
.Visible = true
Wscript.Sleep SleepTime

StrBuf = Cstr(oFile.Path)
Set oFile = Nothing
Set fso = Nothing

.OpenCurrentDataBase StrBuf,False ,""
Wscript.Sleep SleepTime
If rex.test(.SysCmd(acSysCmdAccessDir)) Then
Wscript.echo "In " & .SysCmd(acSysCmdAccessDir) & "32bit Access 2000 Later Version " & _
       .Version & " is istalled." 
Else
Wscript.echo "In " & .SysCmd(acSysCmdAccessDir) & " 64Bit Access 2000 Later Version " & _
       .Version & " is istalled." 
End IF
Select Case .CurrentDb.Version
Case "12.0"
    WScript.Echo "accdb file Version 12.0 is Access 2007"
Case "14.0"
    WScript.Echo "accdb file Version 14.0 is Access 2010"
Case "15.0"
    WScript.Echo "accdb file Version 15.0 is Access 2013"
Case "16.0"
    WScript.Echo "accdb file Version 16.0 is Access 2016 or Access 2019"
Case Else
    On error resume next
    sngNum = CSng(.CurrentDb.Version)
    If Err.Number <> 0 Then
        WScript.Echo "accdb file Version is " & .CurrentDb.Version  & ".  Unknown Version Number or Name maybe Access 2019 after Latest Version."
        Wscript.Quit
    Else
        IF sngNum < 16.7 And sngNum >= 16 then
            WScript.Echo testmdbFileName & vbCrLf & "Current Version Number is " &  .CurrentDb.Version & " AccessVersion " & sngNum & ".  This accdb file Version 16.0 is Access 2016 or Access 2019 And Can not use Bigint Number."
        ElseIF sngNum >= 16.7 Then
            WScript.Echo testmdbFileName & vbCrLf & "Current Version Number is " &  .CurrentDb.Version & " AccessVersion " & sngNum & ". This accdb file Version 16.7 Later is Access 2016 or Access 2019 And Can use or uses Bigint Number.This accdb file can open only access 2016 Later."
        End IF
    End IF
End Select '0087
.CloseCurrentDatabase
.Quit

End With '0070
End IF '0066
Wscript.Quit

' /////////////////////////////////// '
'/////// Function   //////////////// '
' /////////////////////////////////// '
Function GetAccVer(strMDBPath)' As String) 'As String
  Dim acApp, cDB
  Dim dbs
  Dim dbe :set dbe = CreateObject("DAO.DBEngine.36")  '[DBEngine オブジェクト (DAO)](https://docs.microsoft.com/ja-jp/office/client-developer/access/desktop-database-reference/dbengine-object-dao)
  Dim sngNum
  Set dbs = Dbe(0).OpenDatabase(strMDBPath) '[Workspace.OpenDatabase メソッド (DAO)](https://docs.microsoft.com/ja-jp/office/client-developer/access/desktop-database-reference/workspace-opendatabase-method-dao)
  'Wscript.Echo dbs.version & "this"
  Select Case dbs.Version '[Version プロパティ (DAO)](https://docs.microsoft.com/ja-jp/office/client-developer/access/desktop-database-reference/database-version-property-dao)
    Case "1.1"
      GetAccVer = "Access1.1"
      dbs.Close
    Case "2.0"
      GetAccVer = "Access2.0"
    Case "3.0"
      If Left(dbs.Properties("AccessVersion"), 2) = "06" Then
        GetAccVer = "Access95"
      Else
        GetAccVer = "Access97"
      End If
      dbs.Close
    Case "4.0"
        sngNum= CSng(dbs.Properties("AccessVersion"))
        'Wscript.Echo sngNum
        If SngNum < 9 And sngNum >=8 Then
        GetAccVer = "Access2000 : Version : 4.0 /AccessVersion" &  dbs.Properties("AccessVersion")
        ElseIf sngNum >=9 Then
        GetAccVer = "Access2000-Access2003 : Version : 4.0 /AccessVersion" &  dbs.Properties("AccessVersion")
        End If
        Dbs.Close
    Case Else
       Set Dbs = Nothing
       Do Until dbs is nothing
       On Error Resume Next
           Wscript.Sleep 500
           If Err.Number<> 0 then Err.Clear : Exit Do
       Loop
    End Select
End Function