Access快速开发平台--企业版平台权限授权保存按钮代码（快速保存）

时　间:2021-08-19 13:46:25
作　者:麥田   ID：11  城市：上海  QQ：3002789054
摘　要:企业版平台权限授权保存按钮代码（快速保存）。
正　文:

一、学员问题描述：

秦皇岛--一斗(541716710) 

在使用Access快速开发平台企业版中的“权限管理”功能，数据库放在服务器的SQLserver场景下，《授权》点一下，需要一分钟多。请问这个情况能提升解决授权速度吗？我用的是2.5.1版本的平台。如下图：

二、解决方法：

把下面的代码放到”授权“按钮的单击事件过程里面，即可提升”授权“速度，如下图：

代码如下：

Public Sub btnSave_Click()

    On Error GoTo ErrorHandler
    SetCursor ctWait
    
    Dim strSqlScripts As String
    Dim strSQL As String
    Dim rst As Object:
    Dim rstTmp As Object:
    
    If GetDatabaseConfig(dptDatabaseType) Like "*SQL Server*" Then
        strSqlScripts = "Delete FROM Sys_RolePermissions Where UserRole='" & Me.lstUserRole & "';" & vbCrLf
        
        strSQL = "Select ModuleID FROM SysLocalModules Where Allow<>0"
        Set rstTmp = CurrentDb.OpenRecordset(strSQL)
        Do Until rstTmp.EOF
            strSqlScripts = strSqlScripts & "Insert INTO Sys_RolePermissions(UserRole,ModuleID,FunctionID)" _
                          & " VALUES('" & Me.lstUserRole & "'," & rstTmp!ModuleID & ",0);" & vbCrLf
            rstTmp.MoveNext
        Loop
        rstTmp.Close
        
        strSQL = "Select ModuleID,FunctionID FROM SysLocalFunctions Where Allow<>0"
        Set rstTmp = CurrentDb.OpenRecordset(strSQL)
        Do Until rstTmp.EOF
            strSqlScripts = strSqlScripts & "Insert INTO Sys_RolePermissions(UserRole,ModuleID,FunctionID)" _
                          & " VALUES('" & Me.lstUserRole & "'," & rstTmp!ModuleID & "," & rstTmp!FunctionID & ");" & vbCrLf
            rstTmp.MoveNext
        Loop
        rstTmp.Close
        
        ServerRunSQL strSqlScripts
    Else
        ClientRunSQL "Delete FROM Sys_RolePermissions Where UserRole='" & Me.lstUserRole & "'"
        
        strSQL = "Select * FROM Sys_RolePermissions Where UserRole='" & Me.lstUserRole & "'"
        Set rst = ADO.OpenRecordset(strSQL, adLockOptimistic, CurrentProject.Connection)
        
        strSQL = "Select ModuleID FROM SysLocalModules Where Allow<>0"
        Set rstTmp = CurrentDb.OpenRecordset(strSQL)
        Do Until rstTmp.EOF
            rst.AddNew
            rst!UserRole = Me.lstUserRole
            rst!ModuleID = rstTmp!ModuleID
            rst!FunctionID = 0
            rst.Update
            rstTmp.MoveNext
        Loop
    
        strSQL = "Select ModuleID,FunctionID FROM SysLocalFunctions Where Allow<>0"
        Set rstTmp = CurrentDb.OpenRecordset(strSQL)
        Do Until rstTmp.EOF
            rst.AddNew
            rst!UserRole = Me.lstUserRole
            rst!ModuleID = rstTmp!ModuleID
            rst!FunctionID = rstTmp!FunctionID
            rst.Update
            rstTmp.MoveNext
        Loop
        rst.Close
    End If
    
    MsgBoxEx LoadString("Authorized successfully!"), vbInformation
    WriteOperationLog Me.Caption, Me.btnSave.Caption, Me.lstUserRole
    
ExitHere:
    Exit Sub
    
ErrorHandler:
    If RDPErrorHandler(Me.Name & ": Sub btnSave_Click()") Then
        Resume
    Else
        Resume ExitHere
    End If
End Sub

Access快速开发平台QQ群 (群号:321554481) 　　　　　　Access源码网店