This is a module I got from another forum (author Eric Barsamian) that compares version numbers between master copy on LAN and users local copy, then updates user's PC with latest version via a batch file........
Option Compare Database
Option Explicit
Public Const apErrDeviceNotAvlble = 68
Public Const apErrFileNotFound = 3024
Public Const apErrPathNotValid = 3044
Public Const apErrTableNotFound = 3078
Public Const apErrComDlgCancel = 32755
Public Const apErrDBCorrupted1 = 3049
Public Const apErrDBCorrupted2 = 3428
Public Const apErrODBCConnFailed = 3151
Public gstrAppPath As String
Public gstrBackEndPath As String
Public gstrBackEndName As String
Public intRepEdited As Integer
Public blnLeaveApplication As Boolean
Function ap_AppInit()
Dim dblocal As Database, dbNet As Database
Dim intCurrError As Integer, strCurrError As String
Dim blnUseJet As Boolean
Dim intAttempts As Integer
DoEvents
DoCmd.Echo True, "Checking Connections..."
blnLeaveApplication = False
Set dblocal = CurrentDb()
gstrAppPath = Left$(dblocal.Name, ap_LastInStr(dblocal.Name, "\"
)
gstrBackEndName = ap_GetDatabaseProp(dblocal, "BackEndName"
gstrBackEndPath = ap_GetDatabaseProp(dblocal, "LastBackEndPath"
blnUseJet = ap_GetDatabaseProp(dblocal, "UseJet"
'-- Section 2: User requested to logout, quit the application
If blnUseJet Then
If ap_LogOutCheck(gstrBackEndPath) Then
Beep
MsgBox "Maintenance is being performed on the backend" & vbCrLf _
& vbCrLf & "All users are requested to logout at this time.", _
vbOKOnly + vbCritical, "Logging Out for Maintenance"
Application.Quit
Exit Function
End If
End If
'-- Section 11: If using Jet, check the version of the front end,
'-- and point to a new one if necessary
If blnUseJet Then
Set dbNet = OpenDatabase(gstrBackEndPath & gstrBackEndName)
If ap_GetDatabaseProp(dblocal, "FrontEndVersion"
<> _
ap_GetDatabaseProp(dbNet, "FrontEndVersion"
Then
Beep
MsgBox ap_GetDatabaseProp(dbNet, "NewVersionMessage"
, _
vbInformation, "New Version Available"
Dim RetVal
RetVal = Shell("\\Eps2\VOL1\Users\SHARED\QA\Database\update.bat", 1)
Application.Quit
End If
'-- Section 12: Save the BackEnd path in the BackEndPath property
'-- for future use.
ap_SetDatabaseProp dblocal, "LastBackEndPath", gstrBackEndPath
End If
End Function
Public Function ap_LocateBackendNoOCX(dblocal, dynSharedTables, strCurrError) As Boolean
Dim strFilename As String
strFilename = ""
ap_LocateBackendNoOCX = True
DoCmd.Echo True
Beep
If MsgBox("A problem has occurred accessing the linked tables." & _
vbCrLf & vbCrLf & "The error was: " & strCurrError & vbCrLf & _
vbCrLf & "Would you like to locate the backend?", vbCritical + _
vbYesNo, "Error with Backend"
= vbYes Then
Do While Dir(strFilename) <> gstrBackEndName
strFilename = InputBox("Please enter the full path and name of the backend database", "Locate BackEnd", gstrBackEndName)
If Dir(strFilename) = gstrBackEndName Then
ap_LinkTables dblocal, dynSharedTables, strFilename
gstrBackEndPath = Left$(strFilename, _
ap_LastInStr(strFilename, "\"
)
ElseIf Len(strFilename) = 0 Then
ap_LocateBackendNoOCX = False
Exit Do
End If
Loop
Else
ap_LocateBackendNoOCX = False
End If
Exit_ap_LocateBackendNoOCX:
Exit Function
Error_ap_LocateBackendNoOCX:
ap_LocateBackendNoOCX = False
Resume Exit_ap_LocateBackendNoOCX
End Function
Function ap_LogOutCheck(strBackEndPath) As Integer
On Error Resume Next
ap_LogOutCheck = Dir(strBackEndPath & "LogOut.FLG", vbHidden) = "LogOut.FLG"
End Function
Function ap_FormIsOpen(strFormName As String) As Integer
Dim frmCurrent As Form
For Each frmCurrent In Forms
If frmCurrent.Name = strFormName Then
ap_FormIsOpen = True
Exit Function
End If
Next frmCurrent
End Function
Function ap_GetDatabaseProp(dbDatabase As Database, strPropertyName As String) As Variant
ap_GetDatabaseProp = dbDatabase.Containers!Databases _
.Documents("UserDefined"
.Properties(strPropertyName).Value
End Function
Sub ap_SetDatabaseProp(dbDatabase As Database, strPropertyName As String, varValue As Variant)
dbDatabase.Containers!Databases.Documents("UserDefined"
.Properties(strPropertyName).Value = varValue
End Sub
Function ap_LastInStr(strSearched As String, strSought As String) As Integer
Dim intCurrVal As Integer, intLastPosition As Integer
intCurrVal = InStr(strSearched, strSought)
Do Until intCurrVal = 0
intLastPosition = intCurrVal
intCurrVal = InStr(intLastPosition + 1, strSearched, strSought)
Loop
ap_LastInStr = intLastPosition
End Function
Public Sub ap_LinkTables(dblocal, dynSharedTables, strDataMDB As String)
On Error GoTo Error_ap_LinkTables
dynSharedTables.MoveFirst
Do Until dynSharedTables.EOF
DoCmd.Echo True, "Linking " & dynSharedTables!TableName & "..."
On Error Resume Next
dblocal.TableDefs.Delete (dynSharedTables!TableName)
On Error GoTo Error_ap_LinkTables
DoCmd.TransferDatabase acLink, "Microsoft Access", strDataMDB, acTable, dynSharedTables!TableName, dynSharedTables!TableName
dynSharedTables.MoveNext
Loop
Exit_ap_LinkTables:
Exit Sub
Error_ap_LinkTables:
MsgBox Err.Description
Resume Exit_ap_LinkTables
End Sub
Public Sub ap_LogOutRemove()
On Error Resume Next
SetAttr gstrBackEndPath & "LogOut.FLG", vbNormal
Kill gstrBackEndPath & "LogOut.FLG"
End Sub
Public Sub ap_LogOutCreate()
On Error Resume Next
'-- Create flag file
Open gstrBackEndPath & "LogOut.FLG" For Output Shared As #1
Close #1
SetAttr gstrBackEndPath & "LogOut.FLG", vbHidden
End Sub
Public Function ap_LocateBackend(dblocal, dynSharedTables, strCurrError) As Boolean
Dim ocxDialog As Object
ap_LocateBackend = True
DoCmd.Echo True
Beep
If MsgBox("A problem has occurred accessing the linked tables." & _
vbCrLf & vbCrLf & "The error was: " & strCurrError & vbCrLf & _
vbCrLf & "Would you like to locate the backend?", vbCritical + _
vbYesNo, "Error with Backend"
= vbYes Then
Set ocxDialog = Forms!SplashScreen!ocxDialogControl.Object
With ocxDialog
.Filename = gstrBackEndName
.InitDir = gstrAppPath
.DialogTitle = "Please Locate " & gstrBackEndName
.Filter = gstrBackEndName
.CancelError = True
.ShowOpen
End With
If Err.Number <> apErrComDlgCancel Then
DoEvents
ap_LinkTables dblocal, dynSharedTables, ocxDialog.Filename
gstrBackEndPath = Left$(ocxDialog.Filename, _
ap_LastInStr(ocxDialog.Filename, "\"
)
Else
ap_LocateBackend = False
End If
Else
ap_LocateBackend = False
End If
Exit_ap_LocateBackend:
Exit Function
Error_ap_LocateBackend:
ap_LocateBackend = False
Resume Exit_ap_LocateBackend
End Function
Sub ap_CheckReplicatedTables()
Dim dblocal As Database
Dim dynCheckRep As Recordset
Dim qdfUpdateRep As QueryDef
Dim strBackEndPath As String, strBackEndName As String
On Error GoTo Error_ap_CheckReplicatedTables
Set dblocal = CurrentDb()
DoCmd.Echo True, "Checking for Replicated Tables..."
'-- Grab the backend and path
strBackEndPath = ap_GetDatabaseProp(dblocal, "LastBackEndPath"
strBackEndName = ap_GetDatabaseProp(dblocal, "BackEndName"
'-- Attach the backend replicated table
'-- and open the query that shows updated replicated tables
On Error Resume Next
dblocal.TableDefs.Delete "BackEndReplicatedTables"
dblocal.TableDefs.Refresh
On Error GoTo Error_ap_CheckReplicatedTables
DoCmd.TransferDatabase acLink, "Microsoft Access", strBackEndPath & strBackEndName, acTable, "ReplicatedTables", "BackEndReplicatedTables"
dblocal.TableDefs.Refresh
Set dynCheckRep = dblocal.OpenRecordset("qCheckBackEndReplication"
'-- If a table has been updated, loop through
If Not dynCheckRep.RecordCount = 0 Then
Set qdfUpdateRep = dblocal.QueryDefs("qUpdateLastReplication"
Do Until dynCheckRep.EOF
DoCmd.Echo True, "Replicating " & dynCheckRep!TableName & ", Please wait..."
'-- Delete the current local table,
'-- and import the backend table
dblocal.TableDefs.Delete dynCheckRep!TableName
dblocal.TableDefs.Refresh
DoCmd.TransferDatabase acImport, "Microsoft Access", strBackEndPath & strBackEndName, acTable, dynCheckRep!TableName, dynCheckRep!TableName
CurrentDb.TableDefs.Refresh
qdfUpdateRep.Parameters("CurrReplicatedTable"
= dynCheckRep!TableName
qdfUpdateRep.Execute
dynCheckRep.MoveNext
Loop
qdfUpdateRep.Close
End If
dblocal.TableDefs.Delete "BackEndReplicatedTables"
DoCmd.Echo True
'-- Clean up
dynCheckRep.Close
Exit Sub
Error_ap_CheckReplicatedTables:
MsgBox Err.Description
Exit Sub
End Sub
HTH
Rick
