Vba 如何在MS ACCES中打开定时消息框而不创建其他窗口
在按下表单上的保存按钮时，我希望运行一个定时消息框，该消息框在1秒后自动关闭。默认的MsgBox命令在用户按OK或Exit之前不会消失 到目前为止，我有一个在线搜索的解决方案：Vba 如何在MS ACCES中打开定时消息框而不创建其他窗口,vba,ms-access,Vba,Ms Access,在按下表单上的保存按钮时，我希望运行一个定时消息框，该消息框在1秒后自动关闭。默认的MsgBox命令在用户按OK或Exit之前不会消失 到目前为止，我有一个在线搜索的解决方案： 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
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的消息吗 一个选项是创建自己的messagebox。您可以在超时情况下打开此文件：
' 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
代码也在GitHub上：一个选项是创建自己的messagebox。您可以在超时情况下打开此文件：
' 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
#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 '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
我写了一个额外的答案，而不仅仅是一个评论，因为它似乎对请求的上下文太重要了 Lone就MatteoNNZ的回答写道：
感谢分享，结果与我用现有代码实现的结果没有什么不同。您的代码还在任务栏上生成了一个临时窗口 但这离你的需求只有一小步之遥 只需向Api提供Microsoft Access窗口应用程序的句柄。hWndAccessApp，即可将生成的消息框“直观地绑定”到Microsoft Access：
MsgBoxTimeout Application.hWndAccessApp, "This message box will be closed after 1 second ", "Automatically closing MsgBox", vbInformation, 0, 1000
#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
我写了一个额外的答案，而不仅仅是一个评论，因为它似乎对请求的上下文太重要了 Lone就MatteoNNZ的回答写道：
感谢分享，结果与我用现有代码实现的结果没有什么不同。您的代码还在任务栏上生成了一个临时窗口 但这离你的需求只有一小步之遥 只需向Api提供Microsoft Access窗口应用程序的句柄。hWndAccessApp，即可将生成的消息框“直观地绑定”到Microsoft Access：
MsgBoxTimeout Application.hWndAccessApp, "This message box will be closed after 1 second ", "Automatically closing MsgBox", vbInformation, 0, 1000
#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
这是我的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
这是我的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
嗯，由于安全限制，我无法从公司的笔记本电脑访问GitHub。然后使用专家交换链接。它附带了一个带有演示和所有代码的zip。我先尝试了一下，但它不是免费的。注册需要订阅，我
我付不起。到目前为止，我只通过开放源码学习VBA访问。该页面上有一个链接，如“单击此处”以访问全文。或者，试试我的OneDrive文件夹。感谢Gustav的持续支持。它确实有效。完整的代码对我来说太难处理了，但我会以此为基点来设计一个可行的解决方案。嗯，由于安全限制，我无法从我公司的笔记本电脑访问GitHub。哦。然后使用专家交换链接。它附带了一个带有演示和所有代码的zip。我先尝试了一下，但它不是免费的。注册需要订阅，我付不起费用。到目前为止，我只通过开放源码学习VBA访问。该页面上有一个链接，如“单击此处”以访问全文。或者，试试我的OneDrive文件夹。感谢Gustav的持续支持。它确实有效。完整的代码对我来说太难处理了，但我将以此为基点设计一个可行的解决方案。感谢分享，结果与我用现有代码实现的结果没有什么不同。您的代码还在任务栏上生成了一个临时窗口。因此，您需要记住VBA在单线程进程上运行，并且MsgBox设计为在关闭之前等待用户操作。实际上，在同一个线程中，没有办法让一个MsgBox和另一个进程关闭MsgBox，您将需要两个线程，一个显示MsgBox，另一个关闭MsgBox，Office应用程序并不是这样设计的，因此，不可能没有另一个进程，即您提到的作为任务栏窗口的进程来执行您尝试执行的操作。@Lone，如果我可以问的话，为什么另一个进程打开几秒钟对您来说是一个问题，因为您知道它将在1秒后关闭？嗯，对我来说，甚至MsgBox都做得很好。但是我的老板希望这个应用程序像一个web界面，如果执行了某个操作，就会弹出一个小通知，然后自动关闭。你的解释很有道理，让我在这个问题上说服我的老板。否则，如果这个额外的窗口真的是个问题，然后，您必须用真正的编程语言编写应用程序，例如C，它已经提供了与Access数据库的轻松交互，在那里，您将能够在同一个应用程序中有两个线程-重点是，将整个应用程序迁移到任务栏上一秒钟都看不到另一个程序打开，这真的有意义吗？感谢分享，结果与我用现有代码实现的结果没有什么不同。您的代码还在任务栏上生成了一个临时窗口。因此，您需要记住VBA在单线程进程上运行，并且MsgBox设计为在关闭之前等待用户操作。实际上，在同一个线程中，没有办法让一个MsgBox和另一个进程关闭MsgBox，您将需要两个线程，一个显示MsgBox，另一个关闭MsgBox，Office应用程序并不是这样设计的，因此，不可能没有另一个进程，即您提到的作为任务栏窗口的进程来执行您尝试执行的操作。@Lone，如果我可以问的话，为什么另一个进程打开几秒钟对您来说是一个问题，因为您知道它将在1秒后关闭？嗯，对我来说，甚至MsgBox都做得很好。但是我的老板希望这个应用程序像一个web界面，如果执行了某个操作，就会弹出一个小通知，然后自动关闭。你的解释很有道理，让我在这个问题上说服我的老板。否则，如果这个额外的窗口真的是个问题，然后，您必须用真正的编程语言编写应用程序，例如C，它已经提供了与Access数据库的轻松交互，在那里，您将能够在同一个应用程序中有两个线程-重点是，将整个应用程序迁移到任务栏上一秒钟都看不到另一个程序打开，这真的有意义吗？看看这个而不是MsgBox:@Andre，它看起来很有希望。我花了一些时间来理解它，但我不知道如何将.dll库加载到我的Access项目中。请看这个而不是MsgBox:@Andre，它看起来很有希望。我花了一些时间来理解它，但我不知道如何将.dll库加载到我的Access项目中。太好了！这就像一个符咒。。。再帮我一个忙，你知道当这个消息弹出时，我怎样才能关闭通知声音吗？我希望这只能在操作系统窗口的设置中实现，所以这将是系统范围内的。好吧，这将是一个很难处理的问题。顺便说一句，你能想出一种方法使“Application.hWndAccessApp”成为MsgBoxTimout函数的一部分，这样我在跨模块/类调用自定义MsgBox函数时就不必键入它了吗？我添加了一个包装器和一个示例调用f
或者你听我的回答。酷。被选为答案！伟大的这就像一个符咒。。。再帮我一个忙，你知道当这个消息弹出时，我怎样才能关闭通知声音吗？我希望这只能在操作系统窗口的设置中实现，所以这将是系统范围内的。好吧，这将是一个很难处理的问题。顺便说一句，你能想出一种方法使“Application.hWndAccessApp”成为MsgBoxTimout函数的一部分，这样我在跨模块/类调用自定义MsgBox函数时就不必键入它了吗？我在我的答案中添加了一个包装器和一个示例调用。被选为答案！