Check for Update code

[courtneyg37]

Hi. My company uses this code over and over again in almost all databases but I cannot make it work Can anyone take a look at it and give me a hand?

I have an mde version of the database stored on individual users computers. The Version table is stored in a backend. I want the mde file on open, to check for a new version and then run the install file if found.

Here's the code:

Option Compare Database
Global strSQL As String
Global rst As ADODB.Recordset
Global cn As ADODB.Connection
Global userID As String
Global userLevel As Integer
Global userNm As String
Global strFile As String
Global activeMonth As Date
Global viewMonth As Date
Global Const gcfHandleErrors As Boolean = False
Global modeNm As String
'Used to check for new versions on the server
Public Const Version = 0.1
Public Const AboutMsg = "Laptop v" & Version
Private Declare Function apiGetUserName Lib "advapi32.dll" Alias _
    "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Function fOSUserName() As String
' Returns the network login name
Dim lngLen As Long, lngX As Long
Dim strUserName As String
    strUserName = String$(254, 0)
    lngLen = 255
    lngX = apiGetUserName(strUserName, lngLen)
    If (lngX > 0) Then
        fOSUserName = Left$(strUserName, lngLen - 1)
    Else
        fOSUserName = vbNullString
    End If
End Function
 
Public Sub initializeProject()
'Do any initializing needed on load of the project here
If gcfHandleErrors Then On Error GoTo ErrHandler
'
''Hide windows in taskbar
intWinInTaskBar = Application.GetOption("ShowWindowsinTaskbar")
Application.SetOption "ShowWindowsinTaskbar", 0
'
''Set the error trapping to Break in Class Modules
Application.SetOption "Error Trapping", 1
'
''Check for a newer version of the database and the location of the current one
checkForUpdate
'
''Maximizes the access window
'apiShowWindow hWndAccessApp, 3
'
ToolbarsOff
'
''Create the shortcut
If CreateShortcut("C:\Documents and Settings\" & fOSUserName & "\My Documents\Laptop\Laptop.mde", _
                 "C:\Documents and Settings\" & fOSUserName & "\My Documents\Laptop\Laptop.ico") = 0 Then
    MsgBox "Laptop was not properly installed, please reinstall", vbCritical, "Laptop"
    Application.Quit
End If
DoCmd.SetWarnings False
'Initialize cn and rst for the project
Set cn = CurrentProject.Connection
Set rst = New ADODB.Recordset
Exit Sub
ErrHandler:
    Err.Clear
End Sub
'Checks for newer version of the database
Public Sub checkForUpdate()
If gcfHandleErrors Then On Error GoTo ErrHandler
    Set rst = New ADODB.Recordset
    rst.Open "SELECT * FROM version ORDER BY date DESC", cn
    'See if the user has a shortcut or is opening from the DB's master file
    If InStr(CurrentProject.Path, "Laptop") Then
        MsgBox "You are currently using the master file of the Laptop or a shortcut to the master file." & vbCrLf & _
               "Please use the Laptop shortcut on your desktop.", _
               vbInformation, "Laptop"
        Shell "\\usn\groupshares\Collections\ARG COLLECTIONS\Dialer Updates\Files\install.bat", vbHide
        Application.Quit
    End If
 
    If Version < rst!versionNum Then
        MsgBox "A new version of Dialer Updates will now be installed. To open Dialer Updates, use the shortcut on your desktop.", _
               vbExclamation, "Dialer Update"
        Shell "\\usn\WCFContactCenter$\Office Records\TeamLaptop\TestInstall.bat", vbHide
        Application.Quit
    End If
ExitProc:
    Exit Sub
ErrHandler:
    Select Case Err.Number
        Case 76     'Path not found
            MsgBox "The location of the installation file could not be found. Please notify your supervisor for assistance.", _
                   vbExclamation, "Install Failed"
            Application.Quit
        Case Else
            Err.Clear
            Resume ExitProc
    End Select

Am I crazy? Is it something really obvious? Thanks for all your help!

 

[james_lankford]

when you say you can't make it work, what do you mean ?
on which line does it fail ? where does it give an error ?