Public Sub VersionUpdate()
Dim localVersion As Single
Dim remoteVersion As Single
Dim currentPath As String
Dim oldPath As String
Dim rs As Recordset
Dim rs2 As Recordset
Dim fso As Object
Dim db As Database
Dim intRight As Integer
Dim filename As String
Set fso = CreateObject("Scripting.FileSystemObject")
Set rs = CurrentDb.OpenRecordset("tbl9WorkControl", dbOpenDynaset, dbSeeChanges)
If Not rs.EOF Then
localVersion = rs("VersionNumber")
currentPath = Nz(rs("CurrentPath"), "")
End If
Set rs = CurrentDb.OpenRecordset("tbl9CompanyInfo", dbOpenDynaset, dbSeeChanges)
If Not rs.EOF Then
remoteVersion = rs("VersionNumber")
End If
If remoteVersion > localVersion Then
If MsgBox("New Version " & remoteVersion & " Found." & vbCrLf & "Would you like to update now?", vbYesNo, "New Version") = vbNo Then Exit Sub
If Not fso.FolderExists(CurrentProject.Path & "\update\") Then fso.CreateFolder CurrentProject.Path & "\update\"
fso.CopyFile rs("ApplicationDownloadPath"), CurrentProject.Path & "\update\", True
intRight = InStrRev(rs("ApplicationDownloadPath"), "\")
filename = Right(rs("ApplicationDownloadPath"), Len(rs("ApplicationDownloadPath")) - intRight)
oldPath = CurrentProject.FullName
Set db = OpenDatabase(CurrentProject.Path & "\update\" & filename, True)
Set rs2 = db.OpenRecordset("tbl9WorkControl", dbOpenTable)
rs2.MoveFirst
rs2.Edit
rs2!currentPath = oldPath
rs2.Update
Set rs2 = Nothing
Set db = Nothing
Shell SysCmd(acSysCmdAccessDir) & "MSAccess.exe " & """" & CurrentProject.Path & "\update\" & filename & """", vbNormalFocus
DoCmd.Quit
ElseIf remoteVersion = localVersion And CurrentProject.FullName <> currentPath Then
Shell Environ$("comspec") & " /c xcopy """ & CurrentProject.FullName & """ """ & currentPath & """ /y", vbHide
Shell SysCmd(acSysCmdAccessDir) & "MSAccess.exe " & """" & currentPath & """", vbNormalFocus
DoCmd.Quit
ElseIf remoteVersion = localVersion And CurrentProject.FullName = currentPath Then
If fso.FolderExists(CurrentProject.Path & "\update") Then
Shell Environ$("comspec") & " /c rd """ & CurrentProject.Path & "\update"" /s /q"
End If
End If
End Sub