Microsoft Access Version Control

Take control of Version Control for your Microsoft Access databases!
Main Points:
In 15 minutes learn to implement Version Control for multiple users and Microsoft Access files.
Refer to Top comments for Objects and VBA code used in video.
Buy the Code:
Working Code presented in video available on Etsy:
www.etsy.com/s...
Thank you for checking-in at Data Check-in! Your source for all things data using Microsoft Access, Excel and VBA.
Subscribe to get the latest videos on Microsoft Access, Excel and VBA!

[@accessisnotdead]

Access files:
VersionManager.accdb
ServiceRequests.accdb
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
Objects in VersionManager.accdb:
Form: frmVersionUpdateMessage
Module: modVersionManager
----------------------------------------
Form Objects:
frmVersionUpdateMessage
txtAlert = controlsource="No Database Value was provided. Close and reopen your Database to check for a new version."
txtCaption = controlsource ="There is a new version available for: " & [txtFromDBName]
txtFromDBName (hidden)
txtFromDBPath(hidden)
txtToDBName(hidden)
txtToDBPath(hidden)
btnUpdate
Form Code:
Option Compare Database
Private Sub btnUpdate_Click()
modVersionManager.VersionUpdate
End Sub
Private Sub txtFromDBName_AfterUpdate()
If IsNull(Me.txtFromDBName.Value) = False Then
txtCaption.Visible = True
txtAlert.Visible = False
Else
txtCaption.Visible = False
txtAlert.Visible = True
End If
End Sub

[@accessisnotdead]

Module Code:
modVersionManager
Option Compare Database
Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal lngMilliSeconds As Long)
Public Function VersionUpdate()
Dim strFromDBName As String, strFromDBPath As String
If IsNull(Form_frmVersionUpdateMessage.txtFromDBName.Value) = False Then
strFromDBName = Form_frmVersionUpdateMessage.txtFromDBName.Value
Else
MsgBox "Error. Contact your administrator. Database Name value was not passed."
Exit Function
End If
If IsNull(Form_frmVersionUpdateMessage.txtFromDBPath.Value) = False Then
strFromDBPath = Form_frmVersionUpdateMessage.txtFromDBPath.Value
Else
MsgBox "Error. Contact your administrator. Database Path value was not passed."
Exit Function
End If
Dim strToDBName As String, strToDBPath As String
If IsNull(Form_frmVersionUpdateMessage.txtToDBName.Value) = False Then
strToDBName = Form_frmVersionUpdateMessage.txtToDBName.Value
Else
MsgBox "Error. Contact your administrator. Database Name value was not passed."
Exit Function
End If
If IsNull(Form_frmVersionUpdateMessage.txtToDBPath.Value) = False Then
strToDBPath = Form_frmVersionUpdateMessage.txtToDBPath.Value
Else
MsgBox "Error. Contact your administrator. Database Path value was not passed."
Exit Function
End If
Dim strFromFullPath As String, strToFullPath As String
strFromFullPath = strFromDBPath & strFromDBName
strToFullPath = strToDBPath & strToDBName
DoCmd.Hourglass True
MsgBox "The Database will now update. This may take a few minutes.", vbInformation, "Processing"
FileCopy strFromFullPath, strToFullPath
MsgBox "Database Updated. Database will now open.", vbInformation, "Success"
Dim appAccess As Access.Application
Set appAccess = CreateObject("Access.Application")
appAccess.OpenCurrentDatabase strToFullPath
appAccess.Visible = True
appAccess.UserControl = True
appAccess.RunCommand acCmdAppMaximize
Set appAccess = Nothing
Application.Quit
DoCmd.Hourglass False
End Function

[@accessisnotdead]

Objects in ServiceRequests.accdb:
Table: tblVersion
Form: frmVersionUpdate
Module: modVersionControl
Macro: AutoExec
Macro: macVersionShowCurrentVersion
----------------------------------------
Table Objects:
tblVersion
Field: VersionID (Number) Primary Key
Field: VersionNo (Short Text)
Only 1 record should exist. Version ID will always be 1.
----------------------------------------
Form Objects:
frmVersionUpdate
Record Source = SELECT tblVersion.VersionNo FROM tblVersion WHERE (((tblVersion.VersionID)=1));
Add field VersionNo to form
Add button btnSetVersion
----------------------------------------
Form Code:
frmVersionUpdate
Option Compare Database
Private Sub btnSetVersion_Click()
Dim strVersionNo As String
strVersionNo = CStr(Me.VersionNo.Value)
SetVersion (strVersionNo)
MsgBox "Version Updated to " & strVersionNo, vbInformation, "Success!"
DoCmd.Close acForm, "frmVersionUpdate", acSaveYes
End Sub

[@accessisnotdead]

----------------------------------------
Module Code:
modVersionControl
Option Compare Database
Option Explicit
' Define constants for the database path and name
Public Const strFromFPath As String = "G:\My Drive\MyNetworkFolder\"
Public Const strFromFName As String = "ServiceRequests.accde"
Public Declare PtrSafe Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hWnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Public Function bFileExists(strFullPath As String) As Boolean
Dim fs As Object
Set fs = CreateObject("Scripting.FileSystemObject")
bFileExists = fs.FileExists(strFullPath)
Set fs = Nothing
End Function
Public Function bFolderExists(strFullPath As String) As Boolean
Dim fs As Object
bFolderExists = False
Set fs = CreateObject("Scripting.FileSystemObject")
bFolderExists = fs.FolderExists(strFullPath)
Set fs = Nothing
End Function

[@accessisnotdead]

Public Function AtStartCheckVersion()
If Left(Application.CurrentProject.Name, 5) = "ADMIN" Then
'Do Nothing
MsgBox "Opening as Admin", vbInformation, "Admin Access"
Else
If bFolderExists(strFromFPath) = False Then
MsgBox "Folder cannot be found. Must be able to access the following folder in Windows Explorer to run database: " & strFromFPath
DoCmd.RunCommand acCmdExit
Exit Function
End If
If bFileExists(strFromFPath & strFromFName) = False Then
MsgBox "File cannot be found. Must be able to access the following file in Windows Explorer to run database: " & strFromFPath & strFromFName
DoCmd.RunCommand acCmdExit
End If
Dim strToFPath As String, strToFName As String
strToFPath = Replace(CurrentDb.Name, Application.CurrentProject.Name, "")
strToFName = Application.CurrentProject.Name
'Is there a new version available?
Dim strVersion As String, strCurrentVersion As String
strVersion = GetVersion(strFromFPath, strFromFName)
strCurrentVersion = GetCurrentVersion
If strCurrentVersion = strVersion Then
'Do Nothing
Else
'Check if version control file exists
If bFileExists(strToFPath & "VersionManager.accde") = False Then
MsgBox "File cannot be found. The version control file must be located in the following path: " & strToFPath & "VersionManager.accde"
DoCmd.RunCommand acCmdExit
Exit Function
End If
End If
If strCurrentVersion strVersion Then
MsgBox "A new version is available. The database must close to update."
DoCmd.Hourglass True
Dim appAccess As Access.Application
Set appAccess = CreateObject("Access.Application")
appAccess.OpenCurrentDatabase strToFPath & "VersionManager.accde", False
appAccess.Forms!frmVersionUpdateMessage!txtFocus.SetFocus
appAccess.Forms!frmVersionUpdateMessage!txtFromDBName.Value = strFromFName
appAccess.Forms!frmVersionUpdateMessage!txtFromDBPath.Value = strFromFPath
appAccess.Forms!frmVersionUpdateMessage!txtToDBName.Value = strToFName
appAccess.Forms!frmVersionUpdateMessage!txtToDBPath.Value = strToFPath
appAccess.Forms!frmVersionUpdateMessage!txtAlert.Visible = False
appAccess.Forms!frmVersionUpdateMessage!txtCaption.Visible = True
appAccess.Forms!frmVersionUpdateMessage!btnUpdate.Visible = True
appAccess.Visible = True
appAccess.UserControl = True
appAccess.RunCommand acCmdAppMaximize
Set appAccess = Nothing
Application.Quit
End If
End If
Exit Function
End Function

[@accessisnotdead]

Public Function GetCurrentVersion() As String
Dim prop As DAO.Property
Dim dbs As DAO.Database
On Error Resume Next
Set dbs = CurrentDb
'Set the property's value
'If it doesn't exist, an error 3270 "Property not found" will occur
GetCurrentVersion = dbs.Containers("Databases")("UserDefined").Properties("Version").Value
dbs.Close
'Clean up
Set prop = Nothing
Set dbs = Nothing
End Function
Public Function GetVersion(strFromFPath As String, strFromFName As String) As String
Dim prop As DAO.Property
Dim dbs As DAO.Database
On Error Resume Next
Set dbs = OpenDatabase(strFromFPath & strFromFName, , True)
'Set the property's value
'If it doesn't exist, an error 3270 "Property not found" will occur
GetVersion = dbs.Containers("Databases")("UserDefined").Properties("Version").Value
dbs.Close
'Clean up
Set prop = Nothing
Set dbs = Nothing
End Function
Public Sub SetVersion(strVersion As String)
Dim prop As DAO.Property
Dim dbs As DAO.Database
On Error Resume Next
Set dbs = CurrentDb
'Set the property's value
'If it doesn't exist, an error 3270 "Property not found" will occur
dbs.Containers("Databases")("UserDefined").Properties("Version") = strVersion
If Err 0 Then
'If the property doesn't exist, create it
Set prop = dbs.CreateProperty("Version", dbText, strVersion)
'Append it to the collection
dbs.Containers("Databases")("UserDefined").Properties.Append prop
End If
'Now read the property
Debug.Print dbs.Containers("Databases")("UserDefined").Properties("Version")
'Clean up
Set prop = Nothing
Set dbs = Nothing
End Sub
Function strGetDBName() As String
strGetDBName = Application.CurrentProject.Name
End Function

[@vincentchikobe649]

That was I really enjoyed it good tutor God bless.Just learning access at 45yrs

[@accessisnotdead]

@vincentchikobe649 welcome to the Access family! We are all life long learners so never too late. On the horizon are plans to show how to integrate Google Forms and Sheets with Access, so there is so much you can do with Access! Stay tuned!

[@bumpersmith]

@@accessisnotdead looking forward to that. Google forms and sheets with Access.

[@ferreira845]

Kelly!!❤❤🎉😊

[@bumpersmith]

I like the direction you are going but Please do not use dark mode.

[@accessisnotdead]

Hey @bumpersmith I really appreciate the heads-up that I had dark mode on! Yikes! Next video you can expect that not to happen ;-) Thank you again!