Securit Module

[Garyj]

Can anyone tell me why I keep getting a compile error with this come, which following "Unable to create an .mde"

I am using Access97

Option Compare Database 'Use database order for string comparisons
Declare Function WNetGetUser Lib "mpr" Alias "WNetGetUserA" (ByVal lpName As String, ByVal lpUserName As String, lpnLength As Long) As Long

Global gLogonID As String
Global gRestriction As String
Option Explicit
Function GetRestriction() As Integer
On Error GoTo GetRestrictionError

Dim Msg As String
Dim DgDef As Integer
Dim Title As String

Dim MyDB As Database
Dim MyQuery As QueryDef, MyParameter As Parameter
Dim MyRecordset As Recordset

Title = "Restriction"

Set MyDB = DBEngine.Workspaces(0).Databases(0)
Set MyQuery = MyDB.QueryDefs("Get Restriction Query") ' Open existing QueryDef.

MyQuery.Parameters("Enter the Logon ID") = gLogonID ' Set parameters.

Set MyRecordset = MyQuery.OpenRecordset() ' Open Recordset.

If MyRecordset.RecordCount = 0 Then Exit Function ' not Forms Request user yet

gRestriction = MyRecordset.Restriction

If Not (IsRuntime() = -1 Or gRestriction = "DEVELOPER") Then
Msg = "Sorry, you do not have design mode access." + Chr(13) + Chr(10)
Msg = Msg + "You must use this system in run-time mode." + Chr(13) + Chr(10)
Msg = Msg + "Please contact your system administrator."
Title = "VIOLATION!"
DgDef = 0 + 16
MsgBox Msg, DgDef, Title
MyRecordset.Close
Application.Quit
End If

MyRecordset.Close

GetRestriction = True

Exit_GetRestriction:
Exit Function

GetRestrictionError:
MsgBox Error$
Resume Exit_GetRestriction
MyRecordset.Close
Application.Quit

End Function

Function IsRuntime() As Integer
On Error GoTo IsRuntimeError

IsRuntime = SysCmd(acSysCmdRuntime)

Exit Function

IsRuntimeError:

If Err = 5 Then
IsRuntime = False
Else
IsRuntime = False
Error Err
End If

End Function

Sub SetSecurity()
On Error GoTo Err_SetSecurity

Dim lpName As String * 255
Dim lpUserName As String * 255
Dim lpnLength As Integer
Dim Status As Integer

Status = WNetGetUser(lpName, lpUserName, 20)
If (Status = 3) Then
gLogonID = "WNetGetUser Failed"
Else
' Return up to first Null.
gLogonID = Left$(lpUserName, InStr(lpUserName, Chr(0)) - 1)
End If

If Not Len(gLogonID) > 0 Then ' if not a LAN user
Msg = "You must have LAN access to use " + Chr(13) + Chr(10)
Msg = Msg + "the Forms Requests Application." + Chr(13) + Chr(10)
Msg = Msg + "Please contact your LAN Security Manager."
DgDef = 48
MsgBox Msg, DgDef, Title
DoCmd.Quit
End If

If Not GetRestriction() Then
Msg = "You must have security access to use this system." + Chr(13) + Chr(10)
Msg = Msg + "Please contact your Unit Head or Supervisor."
DgDef = 48
MsgBox Msg, DgDef, Title
DoCmd.Quit
End If

'SetSecurity = True

Exit_SetSecurity:
Exit Sub

Err_SetSecurity:
MsgBox Error$
Resume Exit_SetSecurity

End Sub



Thank you in advance

 

[yippie_ky_yay]

Hey Garyj,

could you narrow it down for us? Did the error highlight any particular part of the code?

Try compiling first - it should be under "Debug" in VBA mode (haven't used 97 in ages!) and let us know what error message reads and where it's highlighted.

-Sean