E
EddiesVoicebox via AccessMonster.com
Hi All,
I have a Staff Database that holds information on all employees and is used
as a reference out to all of the MI Teams other systems to provide the
staffing information for our reporting. Recently we have had problems with
other areas accessing this database and would like to block access to evryone
bar a set of select users. I came across some code to do exactly what i want
on an old unused database (i will include below) but i am concerned that all
of the linked tables that are connected out to the other systems will no
longer work. When linking tables you have to enter the password if there is
one set. How would this code get around that, is it even possible to do. Any
advice would be stupendously helpful.
EddiesVoicebox
[Code/]
Option Compare Database
Option Explicit
' Declare for call to mpr.dll.
Declare Function WNetGetUser Lib "mpr.dll" _
Alias "WNetGetUserA" (ByVal lpName As String, _
ByVal lpUserName As String, lpnLength As Long) As Long
Const NoError = 0 'The Function call was successful
Global strAppName As String, strForm As String
Global strEmployee As String
Global CRFlag As Boolean
Function Main()
strAppName = "Churchill Retail Risk Management Database."
Dim strForm As String
Dim x As Integer
x = GetUserName
CRFlag = False
strForm = "mainFRM"
Call OpenAForm(strForm)
End Function
Function GetUserName()
' Buffer size for the return string.
Const lpnLength As Integer = 255
' Get return buffer space.
Dim STATUS As Integer
' For getting user information.
Dim lpName, lpUserName As String
' Assign the buffer size constant to lpUserName.
lpUserName = Space$(lpnLength + 1)
' Get the log-on name of the person using product.
STATUS = WNetGetUser(lpName, lpUserName, lpnLength)
' See whether error occurred.
If STATUS = NoError Then
' This line removes the null character. Strings in C are null-
' terminated. Strings in Visual Basic are not null-terminated.
' The null character must be removed from the C strings to be used
' cleanly in Visual Basic.
lpUserName = Left$(lpUserName, InStr(lpUserName, Chr(0)) - 1)
Else
' An error occurred.
MsgBox "Unable to get the name."
End
End If
' Display the ID of the person logged on to the machine.
If IsNull(DLookup("[NAME]", "AUTHORISATIONTBL", "[LOGON] = '" &
lpUserName & "'")) = True Then
MsgBox "You do not have authorisation to use this Database.
To gain access please speak to Claire Towers on 0208-313-8798.",
vbExclamation, "Authorisation..."
DoCmd.Quit
'strEmployee = lpUserName
Else
strEmployee = DLookup("[NAME]", "AUTHORISATIONTBL", "[LOGON] = '"
& lpUserName & "'")
End If
End Function
Sub OpenAForm(strForm As String)
DoCmd.OpenForm strForm
End Sub
Private Sub Form_Load()
Forms.reportlistfrm.Caption = strAppName & " : " & strEmployee & "."
User = strEmployee
End Sub[/code]
I have a Staff Database that holds information on all employees and is used
as a reference out to all of the MI Teams other systems to provide the
staffing information for our reporting. Recently we have had problems with
other areas accessing this database and would like to block access to evryone
bar a set of select users. I came across some code to do exactly what i want
on an old unused database (i will include below) but i am concerned that all
of the linked tables that are connected out to the other systems will no
longer work. When linking tables you have to enter the password if there is
one set. How would this code get around that, is it even possible to do. Any
advice would be stupendously helpful.
EddiesVoicebox
[Code/]
Option Compare Database
Option Explicit
' Declare for call to mpr.dll.
Declare Function WNetGetUser Lib "mpr.dll" _
Alias "WNetGetUserA" (ByVal lpName As String, _
ByVal lpUserName As String, lpnLength As Long) As Long
Const NoError = 0 'The Function call was successful
Global strAppName As String, strForm As String
Global strEmployee As String
Global CRFlag As Boolean
Function Main()
strAppName = "Churchill Retail Risk Management Database."
Dim strForm As String
Dim x As Integer
x = GetUserName
CRFlag = False
strForm = "mainFRM"
Call OpenAForm(strForm)
End Function
Function GetUserName()
' Buffer size for the return string.
Const lpnLength As Integer = 255
' Get return buffer space.
Dim STATUS As Integer
' For getting user information.
Dim lpName, lpUserName As String
' Assign the buffer size constant to lpUserName.
lpUserName = Space$(lpnLength + 1)
' Get the log-on name of the person using product.
STATUS = WNetGetUser(lpName, lpUserName, lpnLength)
' See whether error occurred.
If STATUS = NoError Then
' This line removes the null character. Strings in C are null-
' terminated. Strings in Visual Basic are not null-terminated.
' The null character must be removed from the C strings to be used
' cleanly in Visual Basic.
lpUserName = Left$(lpUserName, InStr(lpUserName, Chr(0)) - 1)
Else
' An error occurred.
MsgBox "Unable to get the name."
End
End If
' Display the ID of the person logged on to the machine.
If IsNull(DLookup("[NAME]", "AUTHORISATIONTBL", "[LOGON] = '" &
lpUserName & "'")) = True Then
MsgBox "You do not have authorisation to use this Database.
To gain access please speak to Claire Towers on 0208-313-8798.",
vbExclamation, "Authorisation..."
DoCmd.Quit
'strEmployee = lpUserName
Else
strEmployee = DLookup("[NAME]", "AUTHORISATIONTBL", "[LOGON] = '"
& lpUserName & "'")
End If
End Function
Sub OpenAForm(strForm As String)
DoCmd.OpenForm strForm
End Sub
Private Sub Form_Load()
Forms.reportlistfrm.Caption = strAppName & " : " & strEmployee & "."
User = strEmployee
End Sub[/code]