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