MSACCESS 2010 Toolbar show for developer hide for users

Rx_

Nothing In Moderation
Local time
Today, 14:21
Joined
Oct 22, 2009
Messages
2,803
This is working for me in a Citrix distribution environment.
If there are other suggestions or improvements, please contribute.

Users have toolbar hidden. As a developer, the toolbar shows up.

Code:
Function IsDeveloper() As Boolean
10        On Error Resume Next ' in general module
20        Dim UserName As String
30        IsDeveloper = False
40        UserName = VBA.Environ("UserName")
50        Select Case UserName
              Case "TheOldProgrammer" ' Your LAN ID Goes Here
60                IsDeveloper = True
70            Case Else
80                IsDeveloper = False
90        End Select          
End Function
In the Start Up form

Private Sub Form_Load()
20 On Error Resume Next
30 If IsDeveloper() Then
40 DoCmd.ShowToolbar "Ribbon", acToolbarYes
50 Else
60 DoCmd.ShowToolbar "Ribbon", acToolbarNo ' hide Ribbon
70 End If
'MsgBox "is developer is " & IsDeveloper, vbOKOnly, "Test Messagebox to evaluate hidden toolbar"
'DoCmd.Maximize
100 DoCmd.Restore ' keeps startup form from Maximizing
End Sub
 
You could have a table of users and then do a comparison. That way you can define users and their permissions without having to hard code it into a table. The users table could have lan id, full name, position, security rating, user level etc what ever you want. Then simply use this function to get the user name:
Private Declare Function api_GetComputerName Lib "kernel32" Alias "GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Public Function atCNames(UOrC As Integer) As String
'**************************************************
'Purpose: Returns the User LogOn Name or ComputerName
'Accepts: UorC; 1=User, anything else = computer
'Returns: The Windows Networking name of the user or computer
'**************************************************
On Error Resume Next
Dim NBuffer As String, sDump As String
Dim Buffsize As Long, Wok As Long, lR As Long
Buffsize = 256
' NBuffer = Space(256)
NBuffer = Space$(Buffsize)
If UOrC = 1 Then
Wok = api_GetUserName(NBuffer, Buffsize)
atCNames = Left$(NBuffer, InStr(NBuffer, Chr(0)) - 1)
Else
Wok = api_GetComputerName(NBuffer, Buffsize)
atCNames = Left$(NBuffer, InStr(NBuffer, Chr(0)) - 1)
End If
sDump = String$(255, " ") 'Create a buffer
lR = api_GetUserName(sDump, 255) 'Fill buffer with ID
GetUserName1 = Left$(sDump, InStr(1, sDump, vbNullChar) - 1) 'Return just the id
' MsgBox (sDump & " " & Wok & lR & " --- " & GetUserName1)
End Function
--------------------------------------------------------------------------------
Then you can set whatever by readin the table:
Note pass the txtName by doing get_username(Actnames(1))
'This function gets the user name from the lan ID but you could set it to get the secirty level or simply have a field named user or developer then set that for each user.
Public Function get_username(txtName As String) As String
Dim myRS As DAO.Recordset
Set myRS = CurrentDb.OpenRecordset("Officer_Lookup", dbOpenDynaset)
myRS.FindFirst "[Officer] LIKE '" & txtName & "'"
If myRS.NoMatch Then
get_username = ""
User_fullname = ""
Else
get_username = myRS![FullName]
User_fullname = myRS![FullName]
End If
myRS.Close
Set myRS = Nothing
CurrentDb.Close
End Function
 
  • Like
Reactions: Rx_

Users who are viewing this thread

Back
Top Bottom