捕获和释放 Ctrl+c（对于整个数据库）

Posted 2023-05-06

【中文标题】捕获和释放 Ctrl+c（对于整个数据库）

【英文标题】：Capture & Release Ctrl+c (For the whole Database)

【发布时间】：2018-07-24 09:15:11

【问题描述】：

如何为某些用户禁用 ctrl+c？ （这应该针对整个数据库而不仅仅是一个表单或报告）

这是我目前得到的：

Public Function ctrlC()
    'prevent unauthorised users from copying data using the ctrl + c shortcut
    If ActiveUserLevel < 2 Then
        'disalbe ctrl + c
        MsgBox "crtl c disabled"
    Else
        'allow user to use ctrl + c
        DoCmd.RunCommand acCmdCopy  'Error: "The cmd or action copy isn't available right now"
    End If
End Function

PS：我意识到您可以在表单中使用 KEY DOWN 事件，但我正在寻找更有效的解决方案（我不想在 100 个不同的表单上调用 key down 方法并且可能会丢失其中一些...)

更新

受 Sion.D.P 评论的启发，另一个想法是构建 2 个宏。一个禁用 ctrl+c 另一个是空白，然后使用此函数根据 userAccessLevel 重命名它们：

Public Sub enableUserShortcuts(val As Boolean)
    On Error Resume Next:
    'swap macro names to enable/disable user shortcut keys

    If val = False Then
        'disable user shorcuts
        DoCmd.RunMacro "AutoKeys_DisableUserShortcuts"  'test if macro needs to be loaded
        If err.number = 0 Then
            DoCmd.Rename "AutoKeys_Blank", acMacro, "AutoKeys"  'save old macro
            DoCmd.Rename "AutoKeys", acMacro, "AutoKeys_DisableUserShortcuts"   'load macro
        End If

    Else
        'enable user shorcuts
        DoCmd.RunMacro "AutoKeys_Blank"  'test if macro needs to be loaded
        If err.number = 0 Then
            DoCmd.Rename "AutoKeys_DisableUserShortcuts", acMacro, "AutoKeys"   'save old macro
            DoCmd.Rename "AutoKeys", acMacro, "AutoKeys_Blank"  'load macro
        End If

    End If

    err.number = 0
    DoCmd.RunMacro "AutoKeys"
End Sub

或者用函数(https://***.com/a/13104045/5148062)导入xml宏文件：

Public Sub enableUserShortcuts(val As Boolean)
    'swap macro names to enable/disable user shortcut keys
    If val = False Then
        'disable user shorcuts
        LoadFromText acMacro, "AutoKeys", "C:\New folder\AutoKeys_DisableUserShortcuts.xml"
    Else
        'enable user shorcuts
        LoadFromText acMacro, "AutoKeys", "C:\New folder\AutoKeys_Blank.xml"
    End If
End Sub

最后两个“解决方案”的问题是，一旦完成上述重命名/导入，数据库似乎没有更新。你必须关闭整个数据库并再次打开它才能工作。如果我不关闭并重新打开，我会收到以下错误：“YourDbName cant find the macro ^c in the macro group autokeys”

【问题讨论】：

你想向用户显示数据，但如果他想使用它，他必须手动输入？如果我在哪里用户，我会诅咒程序员并尝试使用***.com/a/21909259/7599798 中描述的解决方案 - 只是我的 2 美分

^^ 正是我要写的——这对你的用户来说会非常烦人。而老前辈只会使用 Ctrl+Insert 和 Shift+Insert 代替 (link) 或寻找其他方式。

有一种方法可以在 Excel 中完成。它在 Excel 中经常用于“关闭”工作簿。

你看到this

@FunThomas 队长的命令,,, 被屏蔽的用户是原始或临时雇员，一旦他们签订合同，他们将拥有更高的访问级别。我们的目标是保护数据，即使它会给少数用户带来不适

【参考方案1】：

使用问题更新部分中描述的宏切换过程导致数据库必须重新启动。这是一个批处理脚本，等待数据库关闭，然后在登录后重新打开它：

Private Sub createDBBatchScript()
    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")

    Dim Fileout As Object
    Set Fileout = fso.CreateTextFile(Environ("temp") & "\vba.cmd", True, False)
    Fileout.Write "@echo off " & vbNewLine & _
                    "Rem used within vba to reopen db, once vba execute this script, " & vbNewLine & _
                    "Rem the script waits for a short while then if the db is closed it reopens it " & vbNewLine & _
                    "Rem if reopend create temp txt file else delete any temp txt files " & vbNewLine & _
                    vbNewLine & _
                    "set /a counter=0 " & vbNewLine & _
                    vbNewLine & _
                    ": runAgain " & vbNewLine & _
                    "set /a counter+=1 " & vbNewLine & _
                    "Rem echo %counter% " & vbNewLine & _
                    vbNewLine & _
                    "if %counter% leq 5000 ( " & vbNewLine & _
                    "    if not exist " & Application.CurrentProject.path & "\DB_FE.laccdb ( " & vbNewLine & _
                    "        Rem echo does not exists " & vbNewLine & _
                    "        echo 1 > %temp%\psReopened.txt " & vbNewLine & _
                    "        Start " & Application.CurrentProject.path & "\DB_FE.accde " & vbNewLine & _
                    "    ) else ( " & vbNewLine & _
                    "        Rem echo still exist " & vbNewLine & _
                    "        goto runAgain) " & vbNewLine & _
                    ") else ( " & vbNewLine & _
                    "    del %temp%\dbReopened.txt " & vbNewLine & _
                    ") " & vbNewLine & _
                    vbNewLine & _
                    "Rem pause "

    Fileout.Close
    Set Fileout = Nothing
    Set fso = Nothing

End Sub

我还添加了一个 AutoExec 宏和函数来清理由 bacth 脚本创建的任何临时剩余文件并帮助平滑登录过程

Public Function startup()
'if db is reopend by bacth script go straight to switchboard else login screen
    If Not Dir(Environ("temp") & "\vba.cmd") = "" Then
        Kill Environ("temp") & "\vba.cmd"

        If Dir(Environ("temp") & "\psReopened.txt") = "" Then
            DoCmd.OpenForm "Login Form"
        Else
            Kill Environ("temp") & "\psReopened.txt"
            DoCmd.OpenForm "SwitchMain"
        End If
    Else
        DoCmd.OpenForm "Login Form"
    End If
End Function

在 vba 中生成所有内容的一个好处是，在运行脚本之前或之后不会有任何剩余文件浮动