Public Function InGroup(strGroupName As String) As Boolean
'#######################################################'
' The public face of this Module's code collection '
'#######################################################'
' This function will return TRUE IF the current user is a member of a _
security user Group with a name matching the string provided in the argument.
On Error GoTo Err_InGroup
' HOWEVER, First it needs to check that the ADOX reference is included in the
' Reference library list because not everyone has this library linked
' Yet it is needed for the Catalog object.
' CheckSetRef is located in the global module mdlReferences
' It checks for the Reference by name in the first parameter
' and if it does not exist, looks for it at the location in the second parameter.
' Only if it fails to verify or establish the link does it return false.
If CheckSetRef("ADOX", "C:\PROGRAM FILES\COMMON FILES\SYSTEM\ADO\MSADOX.DLL") Then
' All is well - Take no action
Else
InGroup = False
MsgBox "There is a problem with the set up of your local copy of MS Access." & vbLf _
& "You need the ADOX Library Reference Set." & vbLf _
& "I attempted to set this for you, but the file I expected to find at " & vbLf _
& "C:\PROGRAM FILES\COMMON FILES\SYSTEM\ADO\MSADOX.DLL" & vbLf _
& "was not there." & vbLf _
& "Please get an Access Administrator to add this reference.", _
, "I can't find the file I need."
Exit Function
End If
InGroup = ProtectedInGroup(strGroupName)
Exit Function
Err_InGroup:
If Err.Number = 3265 Then
MsgBox "The Group Name provided in the InGroup() function call '" _
& strGroupName & "'" & vbLf & " does not match a group name in the current " _
& "system.mdw file.", , "Code Error"
Else
MsgBox Err.Description, , Err.Number
End If
End Function
Private Function ProtectedInGroup(strGroupName As String) As Boolean
'###################################################################'
' The ADOX library is not linked by default. '
' However it is vital for this piece of code to operate '
' Therefore, then InGroup Function just checks to see '
' if the Library is present & links it if not. '
' ProtectedInGroup can then go and use the library. '
' If the procs were not split in this way the line '
' Dim cat As New ADOX.Catalog would cause a Run Time Compile Error '
' before the linking code could do it's work. '
'###################################################################'
Dim lngPerm As Long
Dim conn As Connection
Set conn = New ADODB.Connection
Set conn = CurrentProject.Connection
Dim cat As New ADOX.Catalog
Set cat.ActiveConnection = conn
ProtectedInGroup = False
Dim usrUser As User
For Each usrUser In cat.Groups(strGroupName).Users
If usrUser = CurrentUser Then
ProtectedInGroup = True
Exit Function
End If
Next
End Function
Public Function CheckSetRef(RefName As String, RefPath As String) As Boolean
'###################################################################'
' Checks to see if a Refernce exist that matches RefName '
' AND check that the link is not broken. '
' If the check fails then it sets up a link using RefPath '
' '
' Returns True if check turned out Okay or if link was successful '
'###################################################################'
Dim ref As Reference
CheckSetRef = False
For Each ref In Application.References
If ref.Name = RefName _
And ref.IsBroken = False _
Then CheckSetRef = True
Next
If CheckSetRef Then
' Link to Reference library exists so make no change
Else
CheckSetRef = ReferenceFromFile(RefPath)
End If
End Function
Private Function ReferenceFromFile(strFileName As String) As Boolean
'###################################################################'
' Used by Function above to do the establishing of the Reference '
'###################################################################'
Dim ref As Reference
On Error GoTo Error_ReferenceFromFile
Set ref = References.AddFromFile(strFileName)
ReferenceFromFile = True
Exit_ReferenceFromFile:
Exit Function
Error_ReferenceFromFile:
MsgBox Err & ": " & Err.Description, , Err.Number
ReferenceFromFile = False
Resume Exit_ReferenceFromFile
End Function
