I am trying to create a VB macro in MS Word in order to automatically format the background colour of content control dropdowns.
I am using a .docm document and setting my content controls like so:
I then selected the 'Macros' button in the developer tab but for some reason I was not able to create a macro via the pop-up as the buttons are greyed out.
I created a new macro via the 'Visual Basic' button the developer tab but it doesn't seem to run.
I think this is due to where the code is being saved, under the 'Normal' header in the editor sidebar, but when I try to select the actual document project I get a pop up error.
My Code
Private Sub Document_ContentControlOnExit(ByVal ContentControl As ContentControl, Cancel As Boolean)
With ContentControl.Range
If ContentControl.Title = "IssueSeverity" Then
Select Case .Text
Case "CRITICAL"
.Cells(1).Shading.BackgroundPatternColor = wdColorDarkRed
Case "HIGH"
.Cells(1).Shading.BackgroundPatternColor = wdColorRed
Case "MEDIUM"
.Cells(1).Shading.BackgroundPatternColor = wdColorOrange
Case "LOW"
.Cells(1).Shading.BackgroundPatternColor = wdColorGreen
Case "INFO"
.Cells(1).Shading.BackgroundPatternColor = wdColorBlue
Case Else
.Cells(1).Shading.BackgroundPatternColor = wdColorAutomatic
End Select
End If
End With
End Sub
What do I need to do within Word (latest version) in order to get macros working?
Looks like you may have the same issue solved by this answer here.
It basically talks about write access to the startup folder where the template is located.
Option #1
Copy template OUT of Start Up Folder, right click file and select
"Open" You can [run/]debug it.
Option #2
Ensure you have write permission to file in startup folder. Even if
you are Admin, if UAC is ON you won't have access - grant your user
"full control" or "write access to file" to DOTM file in startup
folder.
Related
I have tried many different ways of doing this but I can't find one that works for the application.
I have a MS Word Template that will be used by another team.
This is the criteria I have been given.
The initial file name must be 'PL' & the right most figures of a text control box. It should also say Issue 01.
The user must be able to chose the save location.
If the user then opens the document at a later date and saves it should retain the name and path.
If the user 'saves as' then it should up issue the Issue number.
The closest I can get to this working is this: -
In the top section I have this: -
Private WithEvents App As Word.Application and Dim n as long
Then in the Document New I have: -
Private Sub Document_New()
Set App = Word.Application
n = 0
End Sub
Then for the execution I have done this: -
Private Sub App_DocumentBeforeSave(ByVal Doc As Document, SaveAsUI As Boolean, Cancel As Boolean)
ActiveDocument.SaveAs2 "PL" & Right(ActiveDocument.SelectContentControlsByTitle("Works Order Number").Item(1).Range.Text, 5) & " Issue " & Format(n, "00") & ".docx", wdFormatDocumentDefault
End Sub
However, this saves before the user has chosen a location. It works but the user needs to chose the location. So I tried this, this just does the same thing.
Private Sub App_DocumentBeforeSave(ByVal Doc As Document, SaveAsUI As Boolean, Cancel As Boolean)
If Cancel = False Then
n = n + 1
ActiveDocument.SaveAs2 "PL" & Right(ActiveDocument.SelectContentControlsByTitle("Works Order Number").Item(1).Range.Text, 5) & " Issue " & Format(n, "00") & ".docx", wdFormatDocumentDefault
ElseIf Cancel = True Then
Exit Sub
End If
End Sub
Any suggestions or help would very much be welcomed. I basically just want to suggest the filename which up issues with every save as. But I cant find a way to influence that without physically saving.
Thank you in advance for your time and support.
You can repurpose ribbon controls (Save) to call your event handler first. Moreover, if required, you may cancel the default action in the event handler. See Temporarily Repurpose Commands on the Office Fluent Ribbon for more information. Repurposing ribbon controls give you a big plus - corresponding keyboard shortcuts are handled by your code as well. So, you will be able to intercept keyboard shortcuts by the same code.
In case of Backstage UI you can hide the SaveAs button and add your own. Read more about the Backstage UI in the following articles:
Introduction to the Office 2010 Backstage View for Developers
Customizing the Layout of Columns in the Office 2010 Backstage View
You really need to learn how to use the online documentation for VBA. If you had looked up DocumentBeforeSave you would have learned that Cancel is always False when the event is triggered. If you set it to True in the event handler it cancels the save.
You need to intercept the save before the dialog has been displayed, but the event is only triggered after the dialog. Because the criteria for Save is to use the standard functionality it is only the FileSaveAs you need to intercept.
Prior to the implementation of the Backstage view (the File tab) this could be solved simply by creating a routine named FileSaveAs. You can still do this and it will intercept the keyboard shortcut or clicking the QAT button. But it will not intercept the backstage commands. Only the event can do that without rebuilding the Backstage view, and the event won't work for you...
As far as intercepting the dialog to set the initial file name, that has been covered on SO before, here for example.
How do I bypass the MSAccess autoexec macro and startup form for a deep-legacy code upgrade of a large MS Access 2003 application with hundreds of forms and reports?
It is an upgrade from Access 2003 to Access 2016, 2019 or 365.
This is a mission critical system kept alive and on crutches for 15 years without any VBA code updates.
Files in the application
Multiple MSAccess files in MDB and ACCDB format
No MSAccess files in MDE or ACCDE formats with compiled VBA code
No MSAccess other files wuch as mdw security files
I run a dos command for the database - PATH_TO_MSACCESS.exe DB_NAME.mdb
I'm using MSAccess.exe 32 bit from Office 365.
Note that there are compatibility and VBA compiler errors if you run on a 64 bit MSAccess.exe if the VBA calls Windows operating system Win32 API methods. This app calls a few (5) Win32 API calls. Technical, MS Access 64 bit will treat some 32 bit data sent in/returned from the Win32 API as 64 bit causing errors.
The most difficult part is that many of the web pages and nearly all Microsoft pages related to this have been deleted from the web.
Tried but did not work
Holding down shift key when you open the MSAccess database
Hitting F11 to open the Navigation Pane in Access (does not open). If Navigation Pane opens I could edit the AutoExec macro or the startup form's Form_Open code
Tried, not perfect, and works
Run a macro which does not exist on MSAccess.exe command line, hit escape multiple times on the error messages, the click on the MSAccess ribbon to get to the VBA code. Messy, but it gets me into the VBA code.
Added a "Stop" as the first line of the macro named "autoexec" and also as the first line of the startup form's "Form_Open()" method. I had to add an empty "Form_Open()" event handler for the form
Current status:
The application runs OK on a machine with MS Access version before 2016
It fails multiple ways when only 32 bit MS Access 365/2019 is installed on the machine.
I have been finding and fixing things like bad configuration file entries, incorrect installation path, etc. but need to debug the VBA startup code and initial form load in the VBA debugger.
I cannot directly get into the VBA debugger on the first line of the AutoExec macro or start up form's Form_Open function. MSAccess always runs the autoexec macro and shows the startup form.
I can get into the VBA by running MSaccess.exe command line and specifying that it runs a macro which does not exist.
Here are possible solutions based on Google searching broken out by Access version since the code/database settings in question could be specific to any Access version from 95 to 2010.
Access 2007: Opening an MS-Access database from the command line without running any of the startup vba code?
Hold down shift key when opening MDB database
Access XP
Open access database without executing scripts or forms
Hold down shift key when opening the Access database
Remove AutoExec macro
Remove the startup form setting from the database
Access 2007:
Emulating a SHIFT key press when using VBA to open an ms-access database secured by an mdw file?
Slightly different case where the Access database is secured by a MDW security file
Same answers
Access XP/2003/2007?
How to skip Autoexec macro when opening MSAccess from MSAccess?
Method One:
Original URL is dead, Internet Archive Wayback machine has an archived copy: https://web.archive.org/web/20101204113950/http://www.mvps.org/access/api/api0068.htm
Send Shift key to Access via code to bypass startup macro if the [AllowbypassKey] is not set
Method Two:
Extract the Autoexec macro from the database, replace it with a blank AutoExec macro
Uses DoCmd.DatabaseTransfer acImport and DoCmd.DatabaseTransfer acExport
Method Three:
Rename the AutoExec macro using VBA code
OpenCurrentDatabase ("Your database")
DoCmd.Rename "Autoexec", acMacro, "tmp_Autoexec"
CloseCurrentDatabase
MS Access keyboard short cuts for getting at the VBA code or objects in an Access database. From https://support.microsoft.com/en-us/office/keyboard-shortcuts-for-access-70a673e4-4f7b-4300-b8e5-3320fa6606e2
I haven't tried the MSAccess keyboard short cuts to see if they let me open and view the Access VBA code, toolbars, table/form dedign viewer, or switch to code editing mode. I've included them here for completeness.
F2 - Switch between Edit mode (with insertion point displayed) and Navigation mode in the Datasheet or Design view
F4 - Open properties pane for an object
F5 - Switch to Form view from the form Design view
F6 - Switch between panes in the MS Access interface
F10 (?) unhide the ribbon
F11 - Show or hide the Navigation Pane
Alt-X, Alt-X,1 - Open the External Data tab in the ribbon
Alt-Y - Open the Database Tools tab in the ribbon
Alt-J,T - Open the Table tab in the ribbon
Alt-X,2 - Open the Add-ins tab in the ribbon
Control-F1 - Expand/collapse the ribbon
Alt-F11 - Switch to/from the VBA editor
Show or hide the MSAccess ribbon toolbar in VBA code. Included here for completeness. This application hides the ribbon bar on application startup.
MSAccess - Minimize the Toolbar Ribbon OnLoad()?
MSAccess 2010 onwards. The acToolbarNo is in the VBA code for this application
DoCmd.ShowToolbar "Ribbon", acToolbarNo 'Hides the full toolbar
DoCmd.ShowToolbar "Ribbon", acToolbarYes 'Show
MSACcess 2010, 2013
CommandBars.ExecuteMso "MinimizeRibbon"
Before MSAccess 2010
SendKeys "^{F1}", False
Special case: You may get an error on the Access startup form if it has a record source which has an error. this is not the case for my application but included here completeness
difficulty tracing microsoft access VBA code
Special case: You get an infinite loop of dialog prompts or errors from the startup form. Hold down the "Control-Break" key while clicking on OK for the error message to break out of the loop of errors. https://bettersolutions.com/vba/debugging/index.htm
It may be possible to break out of the main startup form to the MS Access object explorer by right clicking on the startup form's title bar or right click on the startup form's body.
Right clicking on the startup form's title bar has these menu commands
Save
Close and Close All
Form View
Layout View
Design View
Right clicking on the startup form's body has these menu commands
Form View
Layout View
Design View
Cut, Copy, Past (disabled)
Form Properties (disabled)
Properties (disabled)
Close
the other thing to check? Are you using a shortcut? if it has the /runtime swtich in it, then the shift key will be ignored NO MATTER what you do, and even if no shfit key by-pass code (to disable) shift key means the shift key will STILL be ignored. So, you want to ensure that you not launching/using a shortcut.
you also want to check/ensure/find out/be aware if the application has workgroup security. Again, in 99 out of 100 cases, the shortcut will show this.
next up:
is this a mdb, or mde file? The mde file is a compiled version. No source code exists, and you can't modify the mde. So, again, ensure that you have a mdb file for the front end, not a mde. If you don't have that mdb, then you are in big trouble - you don't have the source code.
You have all this info in your post, but you leave out the most important issues.
So, is this a mde, or mdb? You need to know this.
Is there a worgroup security file (mdw) specifed in the link that is typical used to launch the application. If workgroup secuirty is involed, then the logon id you use might get you past shift key, but then that user might not have been given design rights, so at that point, shify key by-pass will be of zero use to get into the code.
I mean, launch your copy of access 2016 or whatever. Then try to import the objects from that database. This way you don't have to use or ever worry about shfit key, but are doing a simple import of the forms, reports and code into a brand new fresh database.
So, another question:
Don't bother launching the application - create a blank new database, and then import from the existing - can you do this? (doing this does NOT copy the shift key setting of the original database).
MSAccess command line lets you tell it what macro to execute on startup.
I ran the following cmd.exe command line which generates multiple errors and allows you to get into the Access database with the navigator and get into the VBA code. Not the best solution but one possibility.
MSAccess.exe DB /X ADEEERETDEREAR
DB is the full path to the Access database
ADEERETDEREAR is a macro which does not exist
Access 2007?
How to disable Macro and Start-Up values while opening the MS Access DB
Access 2003?
Bypasss shift key. These link to Zip files projects available for download
https://web.archive.org/web/20071214172548/http://www.members.shaw.ca/AlbertKallal/msaccess/msaccess.html
https://web.archive.org/web/20071214172548/http://www.members.shaw.ca/AlbertKallal/msaccess/shiftkey.zip
https://web.archive.org/web/20071214172548/http://www.members.shaw.ca/AlbertKallal/msaccess/shiftkey2000.zip
Access 2007:
remove autoexec macro from MS Access 2007
Create new macro and then rename it in the Access UI to autoexec, say yes to the prompt to overwrite the existing AutoExec macro
Access 2010?
Opening an MS-Access database from the command line without running any of the startup vba code?
Access ?
Disable F11 Key in MS Access to prevent opening the Navigation Pane
Open the Access database, let the main form be shown
Hit F11 to show the navigation pane
A guess that one could modify the autoexec macro and/or the startup form from the navigation pane
Access ?
https://bytes.com/topic/access/answers/211664-programatically-set-startup-form
A guess that you could use VBA in one Access database to open the target database
Get the name of the startup form
Change the startup form's name or maybe blank out the startup form's name
VBA code similar to CurrentDB.Properties("StartupForm") = "MyForm"
Another guess would be to blank out the startup form's name in the database properties
Same may work for the autoexec macro
Access 2010?
Reset startup form to nothing in VBA code
Code from 2012 is here: https://www.tek-tips.com/viewthread.cfm?qid=1673392
First way
Dim strOriginalForm as String
Dim db as Database
Sub RemoveStartup()
Set db = OpenDatabase(yourdatabase)
strOriginalForm = db.Properties("StartUpForm")
db.Properties("StartUpForm") = "(none)"
db.Close
set db = Nothing
End Sub
Sub ResetStartup()
Set db = OpenDatabase(yourdatabase)
db.Properties("StartUpForm") = strOriginalForm
db.Close
Set db = Nothing
End Sub
Second way
Set prp = db.CreateProperty("AllowByPassKey", dbBoolean, True)
db.Properties.Append prp
Third way
Delete the property using - database.properties.delete propertyname
A more complete example from the same page exists.
I have not tried to import the Access objects into a new database. (Thanks Albert Kallal for the information)
This would allow me to look at the VBA code. It may not work as a replacement for the original database with all of the settings internal to the database.
How to import the Access objects from another Access database:
https://support.microsoft.com/en-us/office/import-database-objects-into-the-current-access-database-23aea08b-7487-499d-bdce-0c76bedacfdd
Access 365 steps (likely works for Access 2016)
External Data tab in ribbon
Click New Data Source -> From Database -> Access in the Import & Link ribbon group
Get External Data - Access Database window is shown
Browse for the MSAccess database MDB or ACCDB file in the File Name Field
The Import Objects window is shown
Select the tables, queries, forms, reports macros, modules to import
In the Options button dialog, you can select menus, toolbars, etc. to import
Click on OK
For Names duplicated, Access will append a 1,2,3 to the end of an imported object's name
Access 2010?
Reset startup form to nothing in VBA code
Code from 2012 is here: https://www.tek-tips.com/viewthread.cfm?qid=1673392
Fourth way as mentioned above
A more complete example from the same page.
Code from 2012 is here: https://www.tek-tips.com/viewthread.cfm?qid=1673392
Public Sub GetCBs()
Dim db As DAO.Database
Dim strPath As String
Dim startUpform As String
Dim app As Access.Application
Dim custBars As Collection
Dim custShortCutBars As Collection
Dim custNonShortCutBars As Collection
Dim i As Integer
Dim blnAutoexec As Boolean
strPath = GetOpenFile()
'Get the db without opening in application
Set db = getDb(strPath)
'Get startupform
startUpform = getStartUp(db)
'Turn off the start up form
TurnOffStartUp db
'Check for and auto exec. If exists import and replace
If hasAutoexec(db) Then
blnAutoexec = True
ImportAutoExec (strPath)
End If
Set app = New Access.Application
'Open safely
app.OpenCurrentDatabase (strPath)
'Read command bars
Set custBars = getCustBars(app)
Set custShortCutBars = getCustShortCutBars(app)
Set custNonShortCutBars = getCustNonShortCutBars(app)
app.CloseCurrentDatabase
Set db = app.CurrentDb
Set db = getDb(strPath)
'Return start up form
TurnOnStartUp db, startUpform
db.Close
'Return auto exec
If blnAutoexec Then
ReturnAutoExec (strPath)
End If
Debug.Print "all custom bars:"
'All bars
For i = 1 To custBars.Count
Debug.Print custBars(i)
Next i
'Do something with the command bars
Debug.Print "all shortcut bars:"
'Short cut only
For i = 1 To custShortCutBars.Count
Debug.Print custShortCutBars(i)
Next i
'Not short cut
Debug.Print "Non shortCut"
For i = 1 To custNonShortCutBars.Count
Debug.Print custNonShortCutBars(i)
Next i
End Sub
Public Function getDb(strPath As String) As DAO.Database
Set getDb = DBEngine(0).OpenDatabase(strPath)
End Function
Public Function getCustBars(app As Access.Application) As Collection
' all bars
Dim col As New Collection
Dim cb As Object
For Each cb In app.CommandBars
If cb.BuiltIn = False Then
col.Add (cb.Name)
End If
Next cb
Set getCustBars = col
End Function
Public Function getCustShortCutBars(app As Access.Application) As Collection
' only short cut bars
Dim col As New Collection
Dim cb As commandbar
For Each cb In app.CommandBars
If cb.BuiltIn = False Then
If cb.Type = msoBarTypePopup Then
col.Add (cb.Name)
End If
End If
Next cb
Set getCustShortCutBars = col
End Function
Public Function getCustNonShortCutBars(app As Access.Application) As Collection
' Menu bars that are not shortcut bars
Dim col As New Collection
Dim cb As commandbar
For Each cb In app.CommandBars
If cb.BuiltIn = False Then
If cb.Type <> msoBarTypePopup Then
col.Add (cb.Name)
End If
End If
Next cb
Set getCustNonShortCutBars = col
End Function
Public Function getStartUp(db As DAO.Database) As String
Dim prp As DAO.Property
For Each prp In db.Properties
If prp.Name = "startupform" Then
getStartUp = prp.Value
Exit For
End If
Next
End Function
Public Sub TurnOffStartUp(db As DAO.Database)
Dim prp As DAO.Property
For Each prp In db.Properties
If prp.Name = "startupform" Then
prp.Value = "(None)"
Exit For
End If
Next
End Sub
Public Sub TurnOnStartUp(db As DAO.Database, strFrm As String)
Dim prp As DAO.Property
For Each prp In db.Properties
If prp.Name = "startupform" Then
prp.Value = strFrm
Exit For
End If
Next
End Sub
Public Sub ImportAutoExec(strPath As String)
On Error GoTo errLbl
DoCmd.TransferDatabase acImport, "Microsoft Access", strPath, acMacro, "AutoExec", "AutoExecBackup"
DoCmd.TransferDatabase acExport, "Microsoft Access", strPath, acMacro, "TempAutoExec", "AutoExec"
Exit Sub
errLbl:
If Err.Number = 7874 Then
Debug.Print "Auto Exec macro does not exist"
Else
MsgBox Err.Number & " " & Err.Description
End If
End Sub
Public Sub ReturnAutoExec(strPath As String)
On Error GoTo errLbl
DoCmd.TransferDatabase acExport, "Microsoft Access", strPath, acMacro, "AutoExecBackup", "AutoExec"
DoCmd.DeleteObject acMacro, "AutoExecBackup"
Exit Sub
errLbl:
If Err.Number = 7874 Then
Debug.Print "Auto Exec macro does not exist"
Else
MsgBox Err.Number & " " & Err.Description
End If
End Sub
Public Function hasAutoexec(db As DAO.Database) As Boolean
Dim rs As DAO.Recordset
Dim strSql As String
strSql = "SELECT MSysObjects.Name FROM MSysObjects WHERE MSysObjects.Name = 'AutoExec' AND MSysObjects.Type = -32766"
Set rs = db.OpenRecordset(strSql)
If Not (rs.EOF And rs.BOF) Then
hasAutoexec = True
End If
End Function
I'm trying to create a template that automatically changes folder suggested by the save prompt to a specified location. I've managed to get it partially working using the following code (modified from here):
Sub FileSave()
Dim UserSaveDialog As Dialog
Set UserSaveDialog = Dialogs(wdDialogFileSaveAs)
'save changes if doc has been saved previously
If ActiveDocument.Path <> "" Then
ActiveDocument.Save
Exit Sub
End If
With UserSaveDialog
.Name = "C:\Users\david\Downloads"
If .Display Then
UserSaveDialog.Execute
End If
End With
End Sub
Using this code, my macro correctly intercepts the default save behaviour (or Ctrl+S), however it doesn't intercept the save dialog when closing the file. I've tried basically copying this code to a new Sub called Document_BeforeSave, FileExit, FileCloseEx and FileCloseAllEx (yes, I am having difficulty with all the different objects and what they do :) all to no avail.
I'm not sure the same code will even work in this event, but I don't even get any indication that it has failed to work, so it seems I'm using the wrong event.
Turns out I somehow missed AutoClose (MS Docs), which does what I want.
I am looking to disable Save As in a Word 2010 file but still allow save. In other words I want users to be able to update the existing file but not create copies. I realize that this is impossible to truly do for people who know workarounds but for the general user I have successfully done this in Excel but am pretty new to word VBA.
When I add the following to a brand new document everything works as intended:
Sub FileSaveAs()
MsgBox "Copies of this file cannot be created. Please save changes in the original document." & _
, , "Copy Cannot be Created"
End Sub
My document has other macros for various command buttons but none of them involve saving the document (under original name or save as). There is also a macro running on open but that is 1 line going to a bookmark. When I try to "save as" in this document I get the message box as intended. When I try to "save" though things get strange: I get the save as dialogue (problem 1). Whether I try to save either under same name or other name the dialogue behaves as it normally would except it doesn't save and the dialogue box opens again automatically essentially creating an endless loop until I hit cancel (problem 2). I also intermittently get a "disk is full" warning pop-up after trying to save which I can dismiss but appears a few minutes later as long as he file is open (perhaps related to autosave?)
Since the macro works in the test file I assumed this strange behavior must be something elsewhere in my code but my document with the other macros saves normally as long as I don't include the save as code above so now I'm totally confused. Before I put up the rest of my code which is lengthy and for the reasons stated above I would not think impact things, I figured I'd ask this:
1. Is there any place other than my other command button macros that could be causing this behavior?
2. Is there a better method people recommend to achieve my ultimate goal of disabling save as but not save?
Thanks in advance for any advice you can provide.
The Word application has a DocumentBeforeSave event. To enable application events I suggest to create a class module by the name of ThisApplication and paste the following code into it.
Option Explicit
Private WithEvents App As Application
Private Sub Class_Initialize()
Set App = Word.Application
End Sub
Private Sub App_DocumentBeforeSave(ByVal Doc As Document, _
SaveAsUI As Boolean, _
Cancel As Boolean)
If SaveAsUI Then
MsgBox "Please always use the ""Save"" command" & vbCr & _
"to save this file.", _
vbExclamation, "SaveAs is not allowed"
Cancel = True
End If
End Sub
Add the following code to your ThisDocument module.
Dim WdApp As ThisApplication
Private Sub Document_Open()
Set WdApp = New ThisApplication
End Sub
You may add the Set App = ... line to your existing Document_Open procedure. After the WdApp variable has been initialised all application events will be received by the ThisApplication class where the DocumentBeforeSave event procedure is programmed not to allow SaveAs.
Of course, this is a blanket refusal for all documents. Therefore you may wish to add code to the procedure to limit the restriction to certain documents only. The proc receives the entire document object with all its properties, including Name, Path, FullName and built-in as well as custom properties. You can identify the files you wish to be affected by any of these.
Note that the WdApp variable will be erased in case of a program crash. If this happens the application events will no longer fire. It may be useful to know that application events occur before document events. This is if you wish to use the application's DocumentOpen event as well as or instead of the document's Document_Open event.
I have a table that has usernames, passwords, and a yes/no column for isadmin.
How do I make it so if they login with an account that has a check mark under "isadmin" they get access to design view, the ribbon, etc? Though if they log in with an account that doesn't have a check mark under the isadmin box they only can view the forms, not edit them, and the ribbon is inaccessible?
I just don't know where to start, as I had assumed there was a way to save the database as a seperate copy that only users can view forms in, and if the admin runs his copy he gets all the changes to the tables (via the forms) the users made. So when the admin edits a form, and saves it it doesn't remove all the user's data as when it was saved, it was saved to the admin's copy too. I'm really confused.
I am using Access 2013
This is a simple solution for user level security being removed in newer releases of Access; using a lot of VBA.
STEP 1: Creating The Table
First, create a table. I will name mine LogininfoT. Now, for the columns inside of the table, name them EmployeeID, LoginID, LoginPassword, EmployeeName, and lastly IsAdmin. Make EmployeeID your key, and IsAdmin a YES/NO field.
For testing, add two users to this table. With this information:
EmployeeID LoginID LoginPassword EmployeeName IsAdmin
1 1111 1234 Bob [x]
2 2222 1234 Stewert [ ]
STEP 2: Creating The Forms
Now that we have the table made, let's design the form to use this set of data.
I will name my form LoginF. Go into design view, and slap down a text box, a combo box, and a button. For the combo box rename the text to say something like Login ID (you can change this to whatever fits your need) and for the text box, put the text as Password (once again, change this to whatever you want it doesn't effect the outcome). The text in the button can be whatever you want, I will be putting Login on it.
Click the combo box and rename it. I will be naming it LoginCmBx. Next, click the text box and rename it, I will be naming it PasswordTxt. Lastly, click the button and rename it, I will be naming it LoginBtn.
Click the combo box again and under the event tab, go into the After Update scripting. Use code and type this in:
Private Sub LoginCmBx_AfterUpdate()
Me.PasswordTxt.SetFocus
End Sub
This makes it so after you select a username, it automatically puts the focus onto the password text box so you can start typing right away without using TAB on your keyboard, or using your mouse.
Next, go to the button and under the event tab, go into the On Click scripting. Use code and type this in:
Private Sub LoginBtn_Click()
If IsNull(Me.LoginCmBx) Or Me.LoginCmBx = "" Then
MsgBox "You must enter a User Name.", vbOKOnly, "Required Data"
Me.LoginCmBx.SetFocus
Exit Sub
End If
If IsNull(Me.PasswordTxt) Or Me.PasswordTxt = "" Then
MsgBox "You must enter a Password.", vbOKOnly, "Required Data"
Me.PasswordTxt.SetFocus
Exit Sub
End If
If Me.PasswordTxt.Value = DLookup("LoginPassword", "LoginInfoT", _
"[EmployeeID]=" & Me.LoginCmBx.Value) Then
EmployeeID = Me.LoginCmBx.Value
On Error Resume Next
DoCmd.DeleteObject acQuery, "IsAdminQ"
On Error GoTo Err_LoginBtn_Click
Dim qdef As DAO.QueryDef
Set qdef = CurrentDb.CreateQueryDef("IsAdminQ", _
"SELECT IsAdmin " & _
"FROM LoginInfoT " & _
"WHERE EmployeeID = " & LoginCmBx.Value)
Exit_LoginBtn_Click:
DoCmd.Close acForm, "LoginF", acSaveNo
DoCmd.OpenForm "MenuF"
Exit Sub
Err_LoginBtn_Click:
MsgBox Err.Description
Resume Exit_LoginBtn_Click
Else
MsgBox "Password Invalid. Please Try Again", vbOKOnly, _
"Invalid Entry!"
Me.PasswordTxt.SetFocus
End If
End Sub
What this does is check if you selected a username, if not it spits out an error telling the user to select one. If you did, it checks if you entered a password. If they didn't, it spits out another error saying they didn't enter a password. If they selected both, and the password doesn't match the one in the table for the username you selected it spits out an error saying you got the password wrong. If you got the password right to the username you selected, it logs you in. It will then close the current form you are on, and open up a new one named "MenuF" it will also create a query with that little bit of information under the username you selected, either if it's an admin or not.. We haven't created MenuF yet, so lets quickly do that. We aren't done with LoginF just quite yet though, so be prepared to come back to that later!
Create the form, and put down a button. Here is your menu form, you can create as many buttons as you want going to other forms or even just put a subform on here and have your entire database. Taht button you put down, you can name the text to whatever you want. I put mine as Log out. Name the button MenuLogOutBtn. Go into the event tab, and under the On Click scripting click code and type this in:
Private Sub MenuLogOutBtn_Click()
DoCmd.DeleteObject acQuery, "IsAdminQ"
DoCmd.OpenForm "LoginF"
DoCmd.Close acForm, "MenuF", acSaveNo
End Sub
What this does is delete the query the login button created, opens the login form again, and closes the menu. Simple!
Now I need you to throw down a checkbox, and name it MyCheckbox. This box requires no special coding, or control sources. Though I do suggest changing visible as no, and deleting the text that comes along with it.
Now, go to the form's event properties and under the Open scripting go to code and type this in:
Private Sub Form_Open(Cancel As Integer)
Me.MyCheckbox.Value = GetLoginStateIsAdmin()
If GetLoginStateIsAdmin = True Then
Me.ShortcutMenu = True
DoCmd.ShowToolbar "Ribbon", acToolbarYes
DoCmd.ShowToolbar "Menu Bar", acToolbarYes
Application.SetOption "ShowWindowsinTaskbar", True
DoCmd.SelectObject acTable, , True
Else
Me.ShortcutMenu = False
DoCmd.ShowToolbar "Ribbon", acToolbarNo
DoCmd.ShowToolbar "Menu Bar", acToolbarNo
Application.SetOption "ShowWindowsinTaskbar", False
DoCmd.NavigateTo "acNavigationCategoryObjectType"
DoCmd.RunCommand acCmdWindowHide
End If
End Sub
What this does is checkbox's information which is attached to query's IsAdmin column and give GetLoginStateIsAdmin that boolean variable. After it does that, it starts a simple If statement that turns off menu bars and disabled right click if you aren't an admin; if you are, it allows you do right click and all menu bars are visible.
Though if you didn't notice yet, our checkbox doesn't get the information from the query yet! Oh no!
STEP 3: Creating The Public Modules
If you were on your toes, you would notice even the login code wouldn't work at this point. First, we need some public modules. Go to the Create tab in the ribbon, and create a module. Type this in:
Public EmployeeID As Long
Save this module as LoginModule.
Create another module, and type this in:
Function GetLoginStateIsAdmin()
'
Dim rst As DAO.Recordset
Set rst = CurrentDb.OpenRecordset("IsAdminQ")
GetLoginStateIsAdmin = Nz(rst(0), False)
Set rst = Nothing
'
End Function
Save this one as GetAdmin.
Lets create one more module; so the user opening the database can't by bass stuff by using the shift key to launch it.
Type this in it:
Function ap_DisableShift()
'This function disable the shift at startup. This action causes
'the Autoexec macro and Startup properties to always be executed.
On Error GoTo errDisableShift
Dim db As DAO.Database
Dim prop As DAO.Property
Const conPropNotFound = 3270
Set db = CurrentDb()
'This next line disables the shift key on startup.
db.Properties("AllowByPassKey") = False
'The function is successful.
Exit Function
errDisableShift:
'The first part of this error routine creates the "AllowByPassKey
'property if it does not exist.
If Err = conPropNotFound Then
Set prop = db.CreateProperty("AllowByPassKey", _
dbBoolean, False)
db.Properties.Append prop
Resume Next
Else
MsgBox "Function 'ap_DisableShift' did not complete successfully."
Exit Function
End If
End Function
Save that as ShiftModule.
We are done the modules! Lets go back to the LoginF now.
STEP 4: Finishing Up LoginF
Go to the form's event tab, and click the on load scripting. Click code, then type this in:
Private Sub Form_Load()
On Error Resume Next
DoCmd.DeleteObject acQuery, "CustomerMoreInfoQ"
End Sub
What this does is make sure that the query the login button creates is deleted when this form starts up, just in case the user closes the database without logging out. So if you click login, it won't cause errors because the query isn't still there.
STEP 5: Testing It Out.
Run the form LoginF in form view, and select Bob as the username. Type in the password 1234 into the password text box, and click login. It should open up the MenuF and you see all menus and you can right click. Good. Now, log out and login with Stewert, using the same password. Now you see all the menus remove themselves, and you can't right click! Yay!
For extra security, in the LoginF's Other tab, make sure Shortcut Menu is set to No. This will set right click to be disabled always; as you aren't logged in as a user at this point. It doesn't know if you are an admin or not.
STEP 6: Disabling The Toolbars On Start Up & launching LoginF On Start Up.
Go to File > Options > Current Database.
Under Display Form, select FormF.
Under the Navigation section, unclick Display Navigation Pane.
Click okay, then go back to LoginF; go into the On Load code and add this just before the End Sub:
DoCmd.ShowToolbar "Ribbon", acToolbarNo
You are done! Save your database, then close it and open it again. It should load the LoginF form where you can't right click, there are no menus etc. The only way to get the menus to edit things is to log into an admin account!
Step 7: Expanding
This doesn't automatically expand the more you add forms though. You need to add that checkbox named MyCheckbox (I suggest copy + pasting it) to each form you add, and add this code to each form you add:
Private Sub Form_Open(Cancel As Integer)
Me.MyCheckbox.Value = GetLoginStateIsAdmin()
If GetLoginStateIsAdmin = True Then
Me.ShortcutMenu = True
Else
Me.ShortcutMenu = False
End If
End Sub
Though once you do that to every form, the security works and you need to log in to an admin account to change anything. If you are just a user, you can use the form normally (click buttons, edit data on subforms, etc) You can't edit the form it self though.