权限 判断函数

  Option Compare Database
Public Const ErrQX = "权限不足!请与管理员联系!"
Public YGNumber As String    '员工编号
Public ygName As String    '员工姓名
'///---------验证用户权限 ------//
Public Function Frm_Qx(Frm As Form, UserID As String)
    '在系统表里寻找登陆用户关于打开窗体的权限记录集   
Dim sql As String   
sql = "SELECT * from Tbl_权限 where 用户='" & UserID & "'and 对象='" & Frm.Name & "';"
    '打开记录集   
Dim db As ADODB.Connection   
Dim rs As New ADODB.Recordset   
Set db = CurrentProject.Connection    rs.Open sql, db, adOpenStatic, adLockReadOnly
        '如果记录为空，改用户没有任何权限        
If rs.BOF And rs.EOF Then            
MsgBox ErrQX, vbCritical, "错误"            
DoCmd.RunCommand acCmdClose            
Exit Function        
End If
        '如果权限为 "全部"        
If rs!完全 = True Then            
Frm.AllowAdditions = True            
Frm.AllowEdits = True            
Frm.AllowDeletions = True
            Exit Function        
End If
        '如果权限为"只读"        
If rs!只读 = True Then            
Frm.AllowAdditions = False            
Frm.AllowEdits = False            
Frm.AllowDeletions = False
             Exit Function        
End If
        '如果全是否,忘记填写了...        
If rs!只读 = False And rs!添加 = False And rs!删除 = False And rs!修改 = False And rs!完全 = False Then            
MsgBox ErrQX, vbCritical, "错误"            
DoCmd.RunCommand acCmdClose            
Exit Function      
End If
        '其他情况就是按照正常的选择了..        
Frm.AllowAdditions = rs!添加        
Frm.AllowEdits = rs!修改        
Frm.AllowDeletions = rs!删除
End Function
'///---------END ------//