dgm said:
Sometime ago I wrote a VB6 program to launch the correct version of MS
Access, depending on what version a file was made with. The program grabs all
the MS Access file types when it loads and after a delay does the same again.
Upon clicking an MS Access file type, the program reads the first 176 bytes
from the file then launches either Access 97 or Access 2000 depending on
what's found.
I'm having to maintain several old databases, continuing with the same
version. Users also need help opening the right version of Access for a file.
The program needs to be updated. All I have myself is 97 and 2000, but users
have all subsequent versions. I have no way of creating sample files for each
of the versions so I can see what they contain.
My logic to determine 97 or 2000 in the first 176 bytes is, if the string
"Standard Jet" is not found or if the string "4.0" is found, the file is
2000. Otherwise it is 97. The location of the MS Access exe is then fetched
from the shell\open\command value in the registry for that version.
Can someone please say what info in the fle indicates the version created
with, for all versions? I will make the updated program available for anyone
who wants it. Thanks
Pasted below is a module ffrom my VB6 program, updated for later versions of
access. The program has no form and only one module.
Attribute VB_Name = "ChooseAccessModule"
Option Explicit
DefInt A-Z
Private Declare Sub Sleep Lib "kernel32.dll" (ByVal dwMilliseconds As Long)
Sub Main()
Dim a$, file$, p, q, exe$, version$, dbeng As Object, dbs As Object, versi,
verss$
file = Trim(Command)
If Left(file, 1) = Chr(34) Then file = Mid(file, 2)
If Right(file, 1) = Chr(34) Then file = Left(file, Len(file) - 1)
If Len(file) = 0 Then
Setup
MsgBox "Setup complete"
Exit Sub
End If
On Error Resume Next
Close
Open file For Binary Access Read As 1
If Err <> 0 Then
MsgBox "The file:" & vbCrLf & _
file & vbCrLf & _
"was not found or failed to open"
Exit Sub
End If
a = Space(32)
Get 1, 1, a
Close
If Asc(Mid(a, 1, 1)) = 1 _
Then
version = "7"
Else
If Asc(Mid(a, 21, 1)) = 0 _
Then
version = "8"
Else
Set dbeng = CreateObject("DAO.DBEngine.36")
If Err <> 0 Then
MsgBox "The file:" & vbCrLf & _
file & vbCrLf & _
"cannot be opened because the correct version of"
& vbCrLf & _
"Microsoft Access is not installed"
Exit Sub
End If
Set dbs = dbeng.OpenDatabase(file, False, False)
If Err <> 0 Then
Err.Clear
Set dbs = dbeng.OpenDatabase(file, True, False)
If Err <> 0 Then
Err.Clear
Set dbs = dbeng.OpenDatabase(file, False, True)
If Err <> 0 Then
Err.Clear
Set dbs = dbeng.OpenDatabase(file, True, True)
End If
End If
End If
If Err <> 0 Then
Set dbeng = Nothing
MsgBox "The file:" & vbCrLf & _
file & vbCrLf & _
"could not be opened as a Microsoft Access
database"
Exit Sub
End If
versi = Int(Val(dbs.Properties("Version")))
If Err <> 0 Then versi = 0
Err.Clear
verss = dbs.Properties("AccessVersion")
If Err <> 0 Then verss = ""
dbs.Close
Set dbs = Nothing
Set dbeng = Nothing
Select Case versi
Case 3
version = "8" '97 format
Case 4
Select Case verss
Case "08.50" '2000 format.
version = "9"
Case "09.50" '2002/3 fomat.
version = "11" 'try 2003 first
End Select
Case 12
version = "12" '97 format
End Select
End If
End If
If Len(version) = 0 Then
MsgBox "The file:" & vbCrLf & _
file & vbCrLf & _
"could not be interrogated for Microsoft Access version"
Exit Sub
End If
exe = RegFunGetValue(HKEY_CLASSES_ROOT, "Access.Application." & version &
"\shell\open\command", "", "")
If Len(exe) = 0 And version = "11" Then
version = "10"
exe = RegFunGetValue(HKEY_CLASSES_ROOT, "Access.Application." & version
& "\shell\open\command", "", "")
End If
If Len(exe) = 0 Then
MsgBox "The correct version of Microsoft Access" & vbCrLf & _
"is not installed for file:" & vbCrLf & _
file
Exit Sub
End If
If InStr(exe, "%1") = 0 Then
MsgBox "Invalid Microsoft Access open command at:" & vbCrLf & _
"Access.Application." & version & "\shell\open\command"
Exit Sub
End If
exe = Replace(exe, "%1", file)
Err.Clear
Shell exe, vbNormalFocus
If Err <> 0 Then
MsgBox "The following command failed to execute:" & vbCrLf & _
exe & vbCrLf & vbCrLf & _
Err.Description
Exit Sub
End If
Sleep 7000
Setup
End Sub
Private Sub Setup()
Dim a$, exe$, f1
exe = App.Path
If Right(exe, 1) <> "\" Then exe = exe & "\"
exe = exe & App.EXEName & ".EXE"
For f1 = 7 To 12
a = "Access.Application." & f1
If Len(RegFunGetValue(HKEY_CLASSES_ROOT, a & "\shell\open\command", "",
"")) > 0 Then
RegFunSetValue HKEY_CLASSES_ROOT, a & "\shell\ChooseAccess\command",
"", """" & exe & """ ""%1""", REG_VB_STRING
RegFunSetValue HKEY_CLASSES_ROOT, a & "\shell", "", "ChooseAccess",
REG_VB_STRING
End If
Next f1
End Sub
' UPDATED: 05-30-2003 [ID]:dgm4B0FkJgNcdY
' UPDATED: 08-13-2005 [ID]:dgm9cr6NO5gbAJ
. I