權限 判斷函數

 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 ------//////////////////////////////////////////////////