Wrox Programmer Forums
| Search | Today's Posts | Mark Forums Read
Access VBA Discuss using VBA for Access programming.
Welcome to the p2p.wrox.com Forums.

You are currently viewing the Access VBA section of the Wrox Programmer to Programmer discussions. This is a community of software programmers and website developers including Wrox book authors and readers. New member registration was closed in 2019. New posts were shut off and the site was archived into this static format as of October 1, 2020. If you require technical support for a Wrox book please contact http://hub.wiley.com
 
Old March 9th, 2016, 11:18 AM
Registered User
Points: 10, Level: 1
Points: 10, Level: 1 Points: 10, Level: 1 Points: 10, Level: 1
Activity: 0%
Activity: 0% Activity: 0% Activity: 0%
 
Join Date: Mar 2016
Posts: 2
Thanks: 0
Thanked 0 Times in 0 Posts
Default VBA Code to secure access

Hi I need help improving a VBA code that someone created for me in 2012using Access 2010 while working at a different agency using a different network server. The code searches for a user's network name in a table called "tblAccess", if their network name isn't in the table, the users will get a message saying that they are not authorized and kick them out of the database. For users who are in the tblAccess table, the objects (tables and etc) are automatically hidden depending on a user's access level. There are two fields in the tblAccess - NetworkName and ScreenAccess (this grants access to certain forms using commands). Also, there is another code that searches for a user's network name in a table called "tblAdmins", if their network name isn't in the table, users will not have the ability to see the objects (tables and etc). The way that this happens is that there is a button that unhide the objects when clicked if the user's name is in the table. If a user name isn't in the table, the unhide button isn't visible. There is only one filed in the tblAdmin table - NetworkName.

The issue that I am having is that the code isn't working 100% correctly here at the new location. For one, at the old location, the code prevented users from right clicking the form to see the form in design view. Now, users who have access can right click the form and view the form in design view. For two, the code only prevents people who are using Access 2010. For people using Access 2013, they are able to access the database although their network name isn't listed in the tblAccess table. Below are the codes:

Module Code:
Option Compare Database
Declare Function WNetGetUser Lib "mpr.dll" Alias "WNetGetUserA" (ByVal lpName As String, ByVal lpUserName As String, lpnLength As Long) As Long

Const NoError = 0
Public Function CheckAdmins() As Boolean
Dim rs As ADODB.Recordset
Dim conn As ADODB.Connection
Dim c As String
Set conn = CurrentProject.Connection

Set rs = New ADODB.Recordset
c = "select count(id) as ADMINS from tblAdmins where NetworkName = '" & GetUserName & "';"
rs.ActiveConnection = conn
rs.Source = c
rs.CursorLocation = adUseServer
rs.LockType = adLockReadOnly
rs.CursorType = adOpenDynamic
rs.Open
CheckAdmins = False
If rs!ADMINS = 1 Then
CheckAdmins = True
End If
rs.Close
Set rs = Nothing

End Function
Public Function CA() As String
Dim rs As ADODB.Recordset
Dim conn As ADODB.Connection
Dim c As String


Set conn = New ADODB.Connection
Set conn = CurrentProject.AccessConnection

Set rs = New ADODB.Recordset
c = "select * from tblAccess where NetworkName = '" & GetUserName & "';"
rs.ActiveConnection = conn
rs.Source = c
rs.CursorLocation = adUseServer
rs.LockType = adLockReadOnly
rs.CursorType = adOpenDynamic
rs.Open
If rs.EOF Then
If CheckAdmins = False Then
MsgBox "You Are Not Authorized"
Application.Quit
End If
Else
CA = rs!ScreenAccess
End If
rs.Close
Set rs = Nothing

End Function

Function GetUserName()

Const lpnLength As Integer = 255

Dim STATUS As Integer
Dim lpName, lpUserName As String

lpUserName = Space$(lpnLength + 1)

STATUS = WNetGetUser(lpName, lpUserName, lpnLength)

If STATUS = NoError Then
lpUserName = Left$(lpUserName, InStr(lpUserName, Chr(0)) - 1)
Else
MsgBox "Unable to get the name."
End
End If
GetUserName = lpUserName

End Function

Public Function UnHideIt()
If isDisableShift Then
If MsgBox("Do you want to Enable Shift", vbYesNo) = vbYes Then
ap_EnableShift
End If
End If
DoCmd.SelectObject acTable, "Form - Home", True

End Function

Public Function HideIt()
ap_DisableShift
DoCmd.SelectObject acTable, "Form - Home", True
DoCmd.RunCommand acCmdWindowHide
End Function

Function ap_EnableShift()

On Error GoTo errEnableShift

Dim db As DAO.Database
Dim prop As DAO.Property
Const conPropNotFound = 3270

Set db = CurrentDb()

db.Properties("AllowByPassKey") = True

Exit Function

errEnableShift:
If Err = conPropNotFound Then
Set prop = db.CreateProperty("AllowByPassKey", _
dbBoolean, True)
db.Properties.Append prop
Resume Next
Else
MsgBox "Function 'ap_DisableShift' did not complete successfully."
Exit Function
End If

End Function

Function isDisableShift() As Boolean

On Error GoTo errDisableShift

Dim db As DAO.Database
Dim prop As DAO.Property
Const conPropNotFound = 3270

Set db = CurrentDb()

isDisableShift = False
If db.Properties("AllowByPassKey") = False Then
isDisableShift = True
End If

Exit Function

errDisableShift:
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
Function ap_DisableShift()


On Error GoTo errDisableShift

Dim db As DAO.Database
Dim prop As DAO.Property
Const conPropNotFound = 3270

Set db = CurrentDb()

db.Properties("AllowByPassKey") = False

Exit Function

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



Form Code (where the unhide button resides):
Private Sub cmdUnhide_Click()
UnHideIt
End Sub

Private Sub Form_Current()

End Sub

Private Sub Form_Load()
Dim a As String
HideIt
cmdUnhide.Enabled = False
cmdUnhide.Visible = False
If CheckAdmins Then
cmdUnhide.Enabled = True
cmdUnhide.Visible = True
End If
a = CA
If a = "" Then
a = "admin"
End If
Command310.Enabled = False
Command248.Enabled = False
Command315.Enabled = False

If a = "View ASAP Master List" Then
Command248.Enabled = True
ElseIf a = "Manage ASAP Master List" Then
Command310.Enabled = True
ElseIf a = "Budget Personnel" Then
Command315.Enabled = True
ElseIf a = "admin" Then
Command310.Enabled = True
Command248.Enabled = True
Command315.Enabled = True

End If
ap_EnableShift

End Sub




Similar Threads
Thread Thread Starter Forum Replies Last Post
Code works in Excel VBA but not Access VBA fossx Access VBA 2 May 21st, 2007 08:00 AM
Beginning Access 2002 VBA Code pajiyar BOOK: Beginning Access VBA 0 July 12th, 2004 08:04 AM
ACCESS 2000 VBA CODE TO "SAVE AS" EXCEL ckentebe Access 0 May 25th, 2004 02:13 PM
Secure VBA code! Timom Excel VBA 4 April 3rd, 2004 06:43 PM
MS Access, VBA code to copy recordset Ivan Classic ASP Databases 1 November 1st, 2003 05:52 PM





Powered by vBulletin®
Copyright ©2000 - 2020, Jelsoft Enterprises Ltd.
Copyright (c) 2020 John Wiley & Sons, Inc.