Public Sub Init()
Dim YesterDay As ADODB.Recordset
Dim strCurrentConn As String
Set YesterDay = New ADODB.Recordset
Dim UserRead As String
Dim booUserRead As Boolean
strCurrentConn = CurrentProject.Connection
UserRead = GetCurrentUserName()
booUserRead = False
YesterDay.Open "tblUsers", strCurrentConn, adOpenStatic, adLockOptimistic
With YesterDay
.MoveFirst
Do Until .EOF
If Trim$(.Fields("UserID")) = UserRead Then booUserRead = True
.MoveNext
Loop
End With
YesterDay.Close
If Not booUserRead Then
MsgBox "У вас нет полномочий для работы с данной базой"
DoCmd.Quit
End If
Set YesterDay = Nothing
End Sub
+модуль
Option Compare Database
Option Explicit
Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Public Function GetCurrentUserName() As String
Dim strName As String
Dim lngChars As Long
Dim lngRet As Long
strName = Space(255)
lngChars = 255
lngRet = GetUserName(strName, lngChars - 1)
If lngRet > 0 Then
GetCurrentUserName = Trim(left(strName, lngChars))
Else
GetCurrentUserName = "Unknow"
End If
End Function
|