如何在 MS ACCESS 中打开定时消息框而不创建其他窗口

Posted 2023-04-19

技术标签:

【中文标题】如何在 MS ACCESS 中打开定时消息框而不创建其他窗口【英文标题】：How to open a timed Message Box in MS ACCES without creating additional window 【发布时间】：2019-03-30 10:38:48 【问题描述】：

按下form 上的Save 按钮时，我想运行一个定时消息框，它会在1 秒后自动关闭。在用户按下OK 或Exit 之前，默认的MsgBox 命令不会消失。

到目前为止，我从网上搜索得到了一个解决方案：

Public Sub Timed_Box (dur AS Long)

Dim WSH AS IWshRuntimeLibrary.WshShell
Dim Res AS Long

Set WSH = IWshRuntimeLibrary.WshShell

Res = WSH.PopUp(Text:="Record Updated", secondstowait:=dur, _ 
Title:="Update", Type:=vbOKOnly)

End Sub

它工作正常。但是，问题在于它会在桌面任务栏上创建一个临时窗口，持续时间对于用户来说非常烦人。无论如何，我可以隐藏此窗口，使其不显示在任务栏上，同时仍显示类似于MsgBox 的消息？

【问题讨论】：

看看这个而不是 MsgBox：***.com/questions/39224308/… @Andre，看起来很有希望。我花了一些时间来理解它，但我不知道如何将 .dll 库加载到我的 Access 项目中。 【参考方案1】：

我写了一个额外的答案而不仅仅是评论，因为它似乎对请求的上下文太重要了。

Lone 写了关于 MatteoNNZ 的回答：

感谢分享，结果与我使用现有代码实现的结果没有什么不同。您的代码还在任务栏上生成了一个临时窗口。

但这距离您的需求仅一步之遥！

只需将您的 Microsoft Access 窗口 (Application.hWndAccessApp) 的句柄提供给 Api，即可让生成的消息框“视觉绑定”到 Microsoft Access：

MsgBoxTimeout Application.hWndAccessApp, "This message box will be closed after 1 second ", "Automatically closing MsgBox", vbInformation, 0, 1000

2019-04-05 更新

这是 MessageBoxTimeout 的包装器，用于简化调用。

参数的顺序和它们的默认值遵循原来的MsgBox函数。

它使用原始 API 函数 namens 为用户定义的过程释放此名称。

我为超时返回值32000添加了一个枚举。

您应该注意添加适当的错误处理。

#If VBA7 Then
Private Declare PtrSafe Function MessageBoxTimeoutA Lib "user32" (ByVal hwnd As LongPtr, ByVal lpText As String, ByVal lpCaption As String, ByVal wType As VbMsgBoxStyle, ByVal wlange As Long, ByVal dwTimeout As Long) As Long
#Else
Private Declare Function MsgBoxTimeout Lib "user32" Alias "MessageBoxTimeoutA" (ByVal hwnd As Long, ByVal lpText As String, ByVal lpCaption As String, ByVal wType As VbMsgBoxStyle, ByVal wlange As Long, ByVal dwTimeout As Long) As Long
#End If

Public Enum VbMsgBoxTimeoutResult
    Timeout = 32000
End Enum

'// If parameter msgTimeoutMilliseconds < 1 then the message box will not close by itself.
'// There is one additional return value to the values of VbMsgBoxResult:
'// If the message box timed out it returns 32000 (VbMsgBoxTimeoutResult.Timeout).
Public Function MsgBoxTimeout(ByVal msgText As String, Optional ByVal msgButtons As VbMsgBoxStyle = vbOKOnly, Optional ByVal msgTitle As String = vbNullString, Optional ByVal msgTimeoutMilliseconds As Long = 0) As VbMsgBoxResult
    MsgBoxTimeout = MessageBoxTimeoutA(Application.hWndAccessApp, msgText, msgTitle, msgButtons, 0, msgTimeoutMilliseconds)
End Function

一个用法示例：

Select Case MsgBoxTimeout("Foo", vbYesNo + vbQuestion, "Bar", 5000)
    Case VbMsgBoxTimeoutResult.Timeout
        Debug.Print "MessageBox timed out."
    Case vbYes
        Debug.Print "User selected 'Yes'."
    Case Else
        Debug.Print "User selected 'No'."
End Select

【讨论】：

太棒了！这就像一个魅力......只是一个好处，你知道当这个消息弹出时我怎样才能关闭通知声音吗？我希望这只能在操作系统 (Windows) 的设置中实现，所以它是系统范围的。好吧，处理起来会很痛苦。顺便说一句，你能想出一种方法让'Application.hWndAccessApp 作为MsgBoxTimout 函数的一部分，这样我在跨modules/ classes 调用custom MsgBox 函数时就不必输入它了吗？我为您的回答添加了一个包装器和一个示例调用。酷。被选为答案！【参考方案2】：

一个选项是创建您自己的消息框。这个你可以用超时打开：

' API call for sleep function.
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)


Public Function OpenFormDialog( _
    ByVal FormName As String, _
    Optional ByVal TimeOut As Long, _
    Optional ByVal OpenArgs As Variant = Null) _
    As Boolean

' Open a modal form in non-dialogue mode to prevent dialogue borders to be displayed
' while simulating dialogue behaviour using Sleep.

' If TimeOut is negative, zero, or missing:
'   Form FormName waits forever.
' If TimeOut is positive:
'   Form FormName exits after TimeOut milliseconds.

    Const SecondsPerDay     As Single = 86400

    Dim LaunchTime          As Date
    Dim CurrentTime         As Date
    Dim TimedOut            As Boolean
    Dim Index               As Integer
    Dim FormExists          As Boolean

    ' Check that form FormName exists.
    For Index = 0 To CurrentProject.AllForms.Count - 1
        If CurrentProject.AllForms(Index).Name = FormName Then
            FormExists = True
            Exit For
        End If
    Next
    If FormExists = True Then
        If CurrentProject.AllForms(FormName).IsLoaded = True Then
            ' Don't reopen the form should it already be loaded.
        Else
            ' Open modal form in non-dialogue mode to prevent dialogue borders to be displayed.
            DoCmd.OpenForm FormName, acNormal, , , , acWindowNormal, OpenArgs
        End If
        ' Record launch time and current time with 1/18 second resolution.
        LaunchTime = Date + CDate(Timer / SecondsPerDay)
        Do While CurrentProject.AllForms(FormName).IsLoaded
            ' Form FormName is open.
            ' Make sure form and form actions are rendered.
            DoEvents
            ' Halt Access for 1/20 second.
            ' This will typically cause a CPU load less than 1%.
            ' Looping faster will raise CPU load dramatically.
            Sleep 50
            If TimeOut > 0 Then
                ' Check for time-out.
                CurrentTime = Date + CDate(Timer / SecondsPerDay)
                If (CurrentTime - LaunchTime) * SecondsPerDay > TimeOut / 1000 Then
                    ' Time-out reached.
                    ' Close form FormName and exit.
                    DoCmd.Close acForm, FormName, acSaveNo
                    TimedOut = True
                    Exit Do
                End If
            End If
        Loop
        ' At this point, user or time-out has closed form FormName.
    End If

    ' Return True if the form was not found or was closed by user interaction.
    OpenFormDialog = Not TimedOut

End Function

然而，要获得消息框的全部功能需要更多的代码，但我的文章中对其进行了仔细的描述和下载：

Modern/Metro style message box and input box for Microsoft Access 2013+

代码也在 GitHub：VBA.ModernBox

【讨论】：

嗯，由于安全限制，我无法从公司笔记本电脑访问 GitHub。哦。然后使用 Expert Exchange 链接。它附上了一个带有演示和所有代码的 zip。我先试过了，但它不是免费的。注册需要订阅，我付不起。到目前为止，我一直只通过开源学习 VBA-Access。该页面上有一个链接，例如“单击此处获取完整文章的访问权限”。或者，试试这个 link 到我的 OneDrive 文件夹。感谢 Gustav 的持续支持。它确实有效。完整的代码对我来说太多了，但我会以此为基础来设计一个可行的解决方案。【参考方案3】：

您可以使用Windows的user32库中提供的MsgBoxTimeout函数。

在模块顶部声明以下内容：

#If Win64 Then 'If the system is in 64b
    Private Declare PtrSafe Function MsgBoxTimeout _
        Lib "user32" _
        Alias "MessageBoxTimeoutA" ( _
            ByVal hwnd As LongPtr, _
            ByVal lpText As String, _
            ByVal lpCaption As String, _
            ByVal wType As VbMsgBoxStyle, _
            ByVal wlange As Long, _
            ByVal dwTimeout As Long) _
    As Long
#Else 'if it's in 32b
    Private Declare Function MsgBoxTimeout _
        Lib "user32" _
        Alias "MessageBoxTimeoutA" ( _
            ByVal hwnd As Long, _
            ByVal lpText As String, _
            ByVal lpCaption As String, _
            ByVal wType As VbMsgBoxStyle, _
            ByVal wlange As Long, _
            ByVal dwTimeout As Long) _
    As Long
#End If

然后像这样使用它：

MsgBoxTimeout 0, "This message box will be closed after 1 second ", "Automatically closing MsgBox", vbInformation, 0, 1000

一些有用的注释：

#If Win64 Then 部分是一个宏，在编译时确定要使用什么声明。事实上，在 64b 系统中，外部库声明的每个函数都应该使用 32b 系统中不存在的 PtrSafe（指针安全）关键字。您以毫秒为单位传递超时，这就是为什么当您希望它等待 1 秒时参数为 1000。

【讨论】：

感谢分享，结果与我使用现有代码实现的结果没有什么不同。您的代码还在任务栏上生成了一个临时窗口。 @Lone，您需要记住 VBA 在单线程进程上运行，并且 MsgBox 旨在在关闭之前等待用户操作。实际上没有办法在同一个线程中拥有一个 MsgBox 和另一个关闭 MsgBox 的进程，您必然需要 2 个线程（一个显示 MsgBox，另一个关闭它），并且 Office 应用程序不是为此而设计的，所以不可能没有另一个进程（你提到的任务栏上的一个窗口）来做你想做的事情。 @Lone，如果我可以问，为什么这个其他进程打开几秒钟对你来说是个问题，知道它会在 1 秒后关闭？嗯，对我来说，即使是 MsgBox 也做得很好。但是我的老板希望该应用程序的行为类似于一个 Web 界面，如果执行一个操作，则会弹出一个小通知，然后自动关闭。你的解释很有道理，让我试着在这个问题上说服我的老板。 @Lone 否则，如果这个额外的窗口确实是个问题，那么您将不得不用真正的编程语言（例如 C#，它已经提供与 Access 数据库的轻松交互）并在那里编写应用程序您将能够在同一个应用程序中拥有 2 个线程 - 关键是，迁移整个应用程序而不在任务栏中看到一个额外的程序打开一秒钟真的有意义吗？【参考方案4】：

这是我的 MessageBoxTimeout 包装器，用于简化调用。我需要返回默认按钮值，而不是返回超时信息。参数和默认值的顺序遵循原来的 MsgBox 函数，以便更好地使用。

Option Compare Database

#If VBA7 Then
Private Declare PtrSafe Function MessageBoxTimeoutA Lib "user32" (ByVal hwnd As LongPtr, ByVal lpText As String, ByVal lpCaption As String, ByVal wType As VbMsgBoxStyle, ByVal wlange As Long, ByVal dwTimeout As Long) As Long
#Else
Private Declare Function MsgBoxTimeout Lib "user32" Alias "MessageBoxTimeoutA" (ByVal hwnd As Long, ByVal lpText As String, ByVal lpCaption As String, ByVal wType As VbMsgBoxStyle, ByVal wlange As Long, ByVal dwTimeout As Long) As Long
#End If

Public Enum vbMsgBoxTimeoutResult
    vbTimeout = 32000
End Enum

'// If parameter msgTimeoutMilliseconds < 1 then the message box will not close by itself.
'// The default timeout is set to 15 sec
'//
Public Function MsgBoxTimeout(ByVal msgText As String, Optional ByVal msgButtons As VbMsgBoxStyle = vbOKOnly, Optional ByVal msgTitle As String = vbNullString, Optional ByVal msgTimeoutMilliseconds As Long = 15000) As VbMsgBoxResult

   'Always set minimal timeout to 1 sec
    If msgTimeoutMilliseconds < 1000 Then msgTimeoutMilliseconds = 1000

    MsgBoxTimeout = MessageBoxTimeoutA(Application.hWndAccessApp, msgText, msgTitle, msgButtons, 0, msgTimeoutMilliseconds)
    
    'timeout action
    If MsgBoxTimeout = VbMsgBoxTimeoutResult_Timeout Then
        
        Dim defaultButtonFlag
        
        'get default button
        defaultButtonFlag = vbDefaultButton1
        If msgButtons And vbDefaultButton4 Then defaultButtonFlag = vbDefaultButton4
        If msgButtons And vbDefaultButton3 Then defaultButtonFlag = vbDefaultButton3
        If msgButtons And vbDefaultButton2 Then defaultButtonFlag = vbDefaultButton2
        
        'get only buttons information
        msgButtons = msgButtons And 7

        'return default value
        If msgButtons = vbYesNo Then
            
            If defaultButtonFlag = vbDefaultButton2 Then
                MsgBoxTimeout = vbNo
            Else
                MsgBoxTimeout = vbYes
            End If
            
        ElseIf msgButtons = vbYesNoCancel Then
            
            If defaultButtonFlag = vbDefaultButton3 Then
                MsgBoxTimeout = vbCancel
            ElseIf defaultButtonFlag = vbDefaultButton2 Then
                MsgBoxTimeout = vbNo
            Else
                MsgBoxTimeout = vbYes
            End If
        
        ElseIf msgButtons = vbAbortRetryIgnore Then
            
            If defaultButtonFlag = vbDefaultButton3 Then
                MsgBoxTimeout = vbIgnore
            ElseIf defaultButtonFlag = vbDefaultButton2 Then
                MsgBoxTimeout = vbRetry
            Else
                MsgBoxTimeout = vbAbort
            End If
    
        ElseIf msgButtons = vbOKCancel Then
         
            If defaultButtonFlag = vbDefaultButton2 Then
                MsgBoxTimeout = vbCancel
            Else
                MsgBoxTimeout = vbOK
            End If
        
        ElseIf msgButtons = vbOKOnly Then
        
            MsgBoxTimeout = vbOK
            
        Else
        
            'do nothing, already MsgBoxTimeout = vbMsgBoxTimeoutResult.vbTimeout
        
        End If
        
    End If
    
End Function

【讨论】：

以上是关于如何在 MS ACCESS 中打开定时消息框而不创建其他窗口的主要内容，如果未能解决你的问题，请参考以下文章

如何从javascript（nodejs）程序调用python，而不创建子进程

如何连接数据框而不丢失列名中的括号？

如何在 Java 中刷新 MS Access 数据库

MS Access 打开错误消息

单击保存按钮后如何在用户窗体中添加依赖于另一个组合框的excel vba组合框而不影响清除数据功能

如何修改多个数据框而不列出它们然后使用 lapply？