Відео

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!

@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!

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

Great idea for another video! How to customize the right click menu. Be sure to subscribe to be alerted of new videos.

@@accessisnotdead that would be great 😀 subscribe? … already done 😉 your Video was a good inspiration for the start!! Thank you 👍

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

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

---------------------------------------- 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

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

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

What if instead of unbound you used the control source for the field you want to update, and then use the default value that would update to the month(field) value. Thru VBA it could update via the on form load or after a field or record update etc. You would have to include some If statements

Hi @coyote10 No blog as of yet. We do have a website datacheckin.com which is undergoing a rebranding. New videos in the works. Stay tuned.

Hi @md.omerkhayyam3343 If your options to hide System tables is on then USysRibbonImages will be hidden.

Hi @44louix The below link from Microsoft will give you a breakdown of all the different types of XML tags you can use for different menu options. A Template would only be useful if it was for a specific type of application that had common commands, but you are really going to want to customize the menu to what makes sense for your application. learn.microsoft.com/en-us/openspecs/office_standards/ms-customui/700e4451-8706-40c5-8d7b-896e4ae21b69

@@accessisnotdead Thanks dear You are the best Love you

@johnclark851 You know it! LOL I figure why not let the cats have a debut :-) Thank you for the compliment on the format. Always open to suggestions to make it easier for all.

@NiftyAccessMicrosoft That comment alone makes all the hard work creating the video worth it! The thing to watch out for is how sensitive the XML code is. Recommend using Notepad++ for editing. Feel free to reply on here if you run into any issues. Happy coding!

If you have any questions or get stuck on anything let me know. It can take some practice editing the Ribbon.

@@accessisnotdead Honestly, with your short videos, it's like i have done the practice and i already create 2 tabs with several menus inside, i learned the basic, and now i can do whatever i want, thanks

@@44louix Woohoo!!!! Go @44louix!

Hi. No need to buy anything or subscribe. All the code included in the comments and shown in the video will get you a working custom Ribbon in Access. The Etsy link is incase you do not want to go thru the UA-cam tutorial. A $2 shortcut for you but not necessary. I'll be sure to be more clear in future videos. Thank you for the feedback!

@joshua4915 I would love to hear your opinion on what made you think the video was a promo. Your opinion matters and helps us to create more helpful videos.