See code below:
Option Compare Database
Option Explicit
Public Const MACRONAME = "Trial Access Database"
Public Const MACROVER = "1.000"
Public Const MACRODATE = "2/28/2010"
Public Const MACROBY = "VirtualIT"
Public Const VPATH = "ServerName"
Public Const VDRIVE = "\FolderName\"
Public Const VERSIONDB = "VersionControl.mdb"
Public Sub CheckVersion()
Dim strSQL As String
Dim cnnConn As New ADODB.Connection
Dim rstVersion As New ADODB.Recordset
Dim OldFile As String
Dim NewFile As String
Dim CurrPath As String
Dim MacroFile As String
Dim fs As Object
'//Connects to Version Control Database
With cnnConn
.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0"
.Open "\\" & VPATH & VDRIVE & VERSIONDB
End With
'//Retrieves Recordset matching the constant MACRONAME
With rstVersion
.CursorType = adOpenForwardOnly
.LockType = adLockReadOnly
.Open "SELECT * FROM tblVersion WHERE MacroName = '" & MACRONAME &
"'", cnnConn
If .EOF Then
MsgBox ("Macro does not exist in database, please email VirtualIT
for assistance.")
Exit Sub
Else
'//Compares the constant MACROVER to the corresponding Version
Number saved in
'the Version control Db
If .Fields("VersionNumber") <> MACROVER Then
'//Informs user that there is a newer version available
MsgBox ("A new version of this macro is available." & vbNewLine
& vbNewLine & _
"Version: " & .Fields("VersionNumber") & " Released: " &
..Fields("ReleaseDate") & "." & _
vbNewLine & vbNewLine & "Please click OK to continue update.")
'//Saves the obsolete Db as Filename_old_MMDDYYYY
Set fs = CreateObject("Scripting.FileSystemObject")
MacroFile = .Fields("MacroPath") & .Fields("MacroFileName")
OldFile = CurrentProject.Name
CurrPath = CurrentProject.path & "\"
NewFile = Mid(OldFile, 1, Len(OldFile) - 4) & "_old_" &
Format(Date, "mmddyyyy") & ".mdb"
fs.copyfile CurrPath & OldFile, CurrPath & NewFile
Call CreateBat(MacroFile, CurrPath & OldFile)
Call CreateVbs(CurrPath, OldFile, NewFile)
MsgBox ("A copy is saved to " & CurrPath & NewFile & vbNewLine &
vbNewLine & _
"Please allow update to finish and new version will open.")
Shell "C:\Temp\CTSGUpdate.bat", vbMaximizedFocus
DoCmd.Quit
End If
End If
.Close
End With
End Sub
Public Sub CreateBat(MacroFile As String, OldFile As String)
Dim FileNum%
FileNum = FreeFile()
Open "C:\Temp\Update.bat" For Output As #FileNum
Print #FileNum, "ECHO Please wait for update to complete..."
Print #FileNum, "@ECHO OFF"
Print #FileNum, "ping -n 5 127.0.0.1 >nul"
Print #FileNum, "ECHO ON"
'//Copy current version of Db to obsolete version file path
Print #FileNum, "XCopy " & Chr$(34) & MacroFile & Chr$(34) & " " &
Chr$(34) & OldFile & Chr$(34) & " /Y"
'//Run C:\Temp\Update.vbs
Print #FileNum, Chr$(34) & "C:\Temp\Update.vbs" & Chr$(34)
Close #FileNum
End Sub
Public Sub CreateVbs(CurrPath As String, OldFile As String, NewFile As String)
Dim FileNum%
FileNum = FreeFile()
Open "C:\Temp\Update.vbs" For Output As #FileNum
Print #FileNum, "Set appAccess = CreateObject(" & Chr$(34) &
"Access.Application" & Chr$(34) & ")"
'//Sets Access security
Print #FileNum, "appAccess.AutomationSecurity = 1"
THIS IS WHERE SOMETHING NEEDS TO BE ADDED SO THAT NO EVENTS RUN UNTIL AFTER
THE TABLES HAVE BEEN UPDATED
'//Opens the current version of the database
Print #FileNum, "appAccess.OpenCurrentDatabase (" & """" & CurrPath &
OldFile & """" & ")"
'//Runs Update subroutine from new Db
Print #FileNum, "appAccess.Run " & Chr$(34) & "Update" & Chr$(34) & ", "
& Chr$(34) & CurrPath & Chr$(34) & ", " & Chr$(34) & NewFile; Chr$(34)
Close #FileNum
End Sub
Private Const TABLES_TO_UPDATE As String = "tbl_test1,tbl_test2,tbl_test3,"
Sub Update(OldPath As String, OldFile As String)
'//Copies all tables from old Db to new db
DoCmd.SetWarnings False
Dim lngStartChr As Long
Dim strUpdateTaleList As String
Dim strUpdateTableName As String
lngStartChr = 1
strUpdateTaleList = Trim(TABLES_TO_UPDATE)
If Right(Trim(strUpdateTaleList), 1) <> "," Then strUpdateTaleList =
strUpdateTaleList & ","
Do Until InStr(lngStartChr, strUpdateTaleList, ",") < 1
strUpdateTableName = Trim(Mid(Trim(strUpdateTaleList), lngStartChr,
InStr(lngStartChr, strUpdateTaleList, ",") - lngStartChr))
If Trim(strUpdateTableName) <> "" Then
DoCmd.RunSQL "SELECT * INTO " & Trim(strUpdateTableName) & "
FROM " & Trim(strUpdateTableName) & " IN '" & OldPath & OldFile & "'"
End If
lngStartChr = InStr(lngStartChr, strUpdateTaleList, ",") + 1
Loop
DoCmd.SetWarnings True
DoCmd.OpenForm ("frm_Start") '//Now open the form that should open on Startup
MsgBox ("Macro updated to version " & MACROVER & ". If you are not
expecting this update, please contact VirtualIT immediately.")
End Sub