"AutoUpgrade" function for Access97 2

Option Compare Database
Option Explicit

Global strCmd As String      ' holds the contents of the /cmd command-line parameter
Const conDoubleQuote = """"  ' holds a double-quote to delimit path names with imbedded spaces

Public Function CheckDatabaseVersion()
'   Check to see that this copy of the database is the latest and, if not,
'   automatically replace it with the newer version
'
    Dim db As Database
    Dim rst As Recordset
    Dim strFileName As String
    Dim strDatabaseName As String
    Dim strLocalPath As String
    Dim dblMasterVersion As Double
    Dim dblLocalVersion As Double
    Dim varRet

    Const conMasterPath = "D:\Applications\"                                 ' location of new front-end database
        
'   First, split the current database name into the file name and the path
    Set db = CurrentDb()
    strLocalPath = db.Name
    strDatabaseName = ""
    Do While Right$(strLocalPath, 1) <> "\"
        strDatabaseName = Right$(strLocalPath, 1) & strDatabaseName
        strLocalPath = left$(strLocalPath, Len(strLocalPath) - 1)
    Loop

'   Next, obtain the highest version number in the master database "Version Info" table
    Set rst = db.OpenRecordset("SELECT Max(tblVersionInfo.VersionNumber) AS VersionNumber FROM tblVersionInfo IN '" & conMasterPath & strDatabaseName & "';")
    rst.MoveFirst
    dblMasterVersion = rst!VersionNumber
    rst.Close
    
'   Then, obtain the highest version number in the local database's "Version Info" table
    Set rst = db.OpenRecordset("SELECT Max(tblVersionInfo.VersionNumber) AS VersionNumber FROM tblVersionInfo;")
    rst.MoveFirst
    dblLocalVersion = rst!VersionNumber
    rst.Close
    
'   If the local version is lower than the master version, ask the user if he wants to take a new copy
'   (unless the database was opened with a /cmd parameter on the command-line
    If dblLocalVersion < dblMasterVersion Then
        If strCmd = "" Then
            varRet = MsgBox("A newer version of the " & strDatabaseName & " database was found.@The newest version is " & Format(dblMasterVersion, "#.00") & ", your version is " & Format(dblLocalVersion, "#.00") & Chr(13) & Chr(10) & Chr(10) & "Using your current version may cause you to miss new features and may cause unpredictable results in existing features.@Do you want to update your database to the newest version?", vbYesNo)
        Else
            varRet = vbYes
        End If
        If varRet = vbYes Then                                      ' take a new copy
            Call UpdateDatabaseVersion(strDatabaseName, strLocalPath, conMasterPath)
        End If
    End If
    
    Set db = Nothing
    
CheckDatabaseVersion_Exit:
    Exit Function

CheckDatabaseVersion_Err:
    MsgBox Err.Description
    Debug.Print Err.Description
    Debug.Print "Could not check for newer version"
    Resume CheckDatabaseVersion_Exit

End Function

Private Sub UpdateDatabaseVersion(strDatabaseName As String, strLocalPath As String, strMasterPath As String)
'   Update the current database with a newer version by creating a batch file that will
'   overlay the current database with the newer database and restart the database
    Dim strAccessDir As String          ' where MS-Access is located on the user's PC
    Dim strLDBName As String
    
    On Error GoTo UpdateDatabaseVersion_Err
    
'   Get the location of MS-Access on the local PC
    strAccessDir = SysCmd(acSysCmdAccessDir)
    
'   Create the name of the LDB file that matches the local database that is being replaced
    strLDBName = strDatabaseName
    If InStr(strLDBName, ".") = 0 Then
        strLDBName = strLDBName & ".ldb"
    Else
        Do While Right$(strLDBName, 1) <> "."
            strLDBName = left$(strLDBName, Len(strLDBName) - 1)
        Loop
        strLDBName = strLDBName & "ldb"
    End If
    
'   Build a new batch file in the same directory as the current database
    Open strLocalPath & "UPDTVER.BAT" For Output As #1
    Print #1, ":Loop"
    Print #1, "IF EXIST " & conDoubleQuote & strLocalPath & strLDBName & conDoubleQuote & " GOTO Loop"
    Print #1, "COPY " & conDoubleQuote & strMasterPath & strDatabaseName & conDoubleQuote & " " & conDoubleQuote & strLocalPath & strDatabaseName & conDoubleQuote
    Print #1, conDoubleQuote & strAccessDir & "Msaccess.exe" & conDoubleQuote & " " & conDoubleQuote & strLocalPath & strDatabaseName & conDoubleQuote & IIf(strCmd = "", "", " /cmd" & strCmd)
    Print #1, "DEL " & conDoubleQuote & strLocalPath & "UPDTVER.BAT" & conDoubleQuote
    Close #1
    
'   Invoke the batch file
    Shell strLocalPath & "UPDTVER.BAT", vbHide  ',vbNormalFocus
    
'   Quit this database
    DoCmd.Quit
UpdateDatabaseVersion_Exit:
    Exit Sub

UpdateDatabaseVersion_Err:
    MsgBox Err.Description
    Debug.Print Err.Description
    Debug.Print "Could not check for newer version"
    Resume UpdateDatabaseVersion_Exit
    
End Sub