Ms access “非阻塞”；吐司；类似Microsoft Access（VBA）的通知

如何在Microsoft Access中显示非阻塞的“toast”类通知？它确实有某种动画，不应该阻止宿主应用程序

我的朋友问我有关ms access的非阻塞toast类通知的问题。我的第一个想法是，检查谷歌你会发现大量的样本。他对得到的样品不满意

他想要类似（JQuery）的非阻塞通知。用户需要知道但不一定需要交互的东西

因为在VBA中线程是不可能的，我想，如果您可以编写自己的.dll呢？所以我最终编写了一个.NETDLL，它可以被（windows）VBA代码访问并显示toast通知。 （实际的dll创建和从vba访问.NET dll是我稍后将讨论的另一个主题）（请根据您的意愿留下评论或建议。）

现在，您可以从这里下载我创建的DLL：

编辑：以上下载链接和GitHub链接已更新为我认为属于作者的工作链接

如果您担心下载未知DLL：

将DLL添加到应用程序的根文件夹中，并将以下代码添加到应用程序中

'Module level public variable

Public gTOASTER As Object

' to save window metrics
Public Type RECT
    Left        As Long  ' x1
    Top         As Long  ' y1
    Right       As Long  ' x2
    Bottom      As Long  ' y2
End Type

#If VBA7 Then 
    Public Declare PtrSafe Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As LongPtr
    Public Declare PtrSafe Function KRISH_VBA_TOOLS Lib "VBA_TOOLS.dll" () As Object
    Public Declare PtrSafe Function GetWindowRect Lib "user32" (ByVal hWnd As LongPtr, ByRef lpRect As RECT) As LongPtr 
#Else
    Public Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal strFilePath As String) As Long
    Public Declare Function KRISH_VBA_TOOLS Lib "VBA_TOOLS.dll" () As Object
    Public Declare Function GetWindowRect Lib "user32" (ByVal hWnd As LongPtr, ByRef lpRect As RECT) As LongPtr
#End If

Public Function FN_TOAST_DLL(iMessage As String, Optional iCLOSE_DURATION As Long = 3000, Optional iType As String = "success", Optional iANIME_DURATION As Long = 1000, Optional iFONT_COLOR As String = "#FFFFFF", Optional iX As Long = 0, Optional iY As Long = 0, Optional iANIME_DIRECTION As Integer = 1, Optional iPARENT_HWND As Long = 0)

On Error GoTo LABEL_EXIT_ROUTINE:

    If gTOASTER Is Nothing Then
        LoadLibrary (FN_APP_GET_BASE_PATH & "VBA_TOOLS.dll")
        Set gTOASTER = KRISH_VBA_TOOLS()
        GoTo LABEL_TOAST
    Else
        GoTo LABEL_TOAST
    End If

    On Error GoTo 0
    Exit Function

LABEL_EXIT_ROUTINE:
    msgbox iMessage & vbnewline & err.description
    Exit Function

LABEL_TOAST:
    'set background color. (pass any html color code)
    Select Case iType
        Case "error"
            iType = "#F76160"
        Case "success"
            iType = "#26ad82"
        Case Else
            iType = "#26ad82"
    End Select

    'if parent object is provided show the toast on top of the parent. if custom x, y is provided use x,y coordinated. if none provided use access app's locaiton.
    Dim mRect As RECT
    If iPARENT_HWND <= 0 Then
        If iX = 0 And iY = 0 Then
            GetWindowRect Application.hWndAccessApp, mRect

            iANIME_DIRECTION = 0 'anim direction 0 to down and 1 to up
        End If
    Else ' iPARENT_HWND > 0 Then 'parent_hwnd is null
        GetWindowRect iPARENT_HWND, mRect
    End If

    'set up some offsets
    iX = mRect.Left + 360
    iY = mRect.Top + 1


    On Error Resume Next
    gTOASTER.FN_SHOW_TOAST iMessage, iCLOSE_DURATION, iType, iANIME_DURATION, iFONT_COLOR, iX, iY, iANIME_DIRECTION

End Function

Public Function FN_APP_GET_BASE_PATH()
    Dim FN As String
    FN = Application.CurrentProject.path
    If VBA.Right(Application.CurrentProject.path, 1) <> "\" Then FN = FN & "\"
    FN_APP_GET_BASE_PATH = FN
End Function

用法：

您可以将其用于任何非交互警报。。例如登录成功、操作取消警报或用户无需按“确定”确认消息的任何内容

目标 我将把Dll项目上传到GitHub上，并请求其他VBA C#专家的贡献，使其更加丰富，并可供所有VBA开发人员使用

这是我的GitHub链接： 请尽可能多地捐款，并让每个人都可以使用：） 如果你能保持主类名不变，我会很高兴的

样本：

---

不确定这是否值得另一个答案！如果没有，请原谅！ 回答“如果我可以发布DLL源代码”，并使那些想参与DLL项目的人更容易阅读/脱颖而出

我已经将DLL项目添加到GitHub，并将添加更新的新函数。如果你想贡献，请做。该项目是用C语言编写的，以证明这一概念，因此代码可能非常混乱。（初期）

新动画

也许将消息发送回主机应用程序

更好的x，y位置处理

不管你怎么想

如果您能将主类名保留为“

KRISH\u VBA\u TOOLS

”，我将非常高兴

这里是GitHub链接：

---

享受。

我解决这个问题的方法是使用内置的Windows 10 toast通知API。我呼吁PowerShell在我们可以利用的地方。我的示例是非阻塞的，因为它在调用PowerShell之后立即返回，所以您的应用程序可以在加载模块时继续。即使PowerShell需要一分钟才能加载，用户也不会注意到。它在我的测试中相当快

首先制作一个如下所示的

Pop Toast.ps1

文件：

## Pop-Toast 
#Requires -Version 5
Param (
    [String]$cmdText="Test",
    [String]$cmdTitle="Example",
    [String]$cmdLogo="$PSScriptRoot\YourLogo.ico",
    [String]$thisApplication,
    [String]$appID
)



## Ensure we have the latest version of our module installed
$toastModule = "BurntToast"
if (Get-Module -ListAvailable -Name $toastModule) {
    # If you uncomment the next line it will update but each call is much slower.
    #Update-Module -Name $toastModule
} 
else {
    try {
        Install-Module -Name $toastModule -AllowClobber -Confirm:$False -Force  
    }
    catch [Exception] {
        $_.message 
        exit
    }
}

## Pop that tart!
$header = New-BTHeader -Id $appID -Title $thisApplication
New-BurntToastNotification -AppLogo $cmdLogo -Header $header -AppId $appID -Text $cmdTitle, $cmdText 

然后，我们制作一个免费的VBA过程来调用我们的PowerShell脚本：

Const PopToastPath As String = "Toast\Pop-Toast.ps1"

Public Sub PopToaster(ByVal toastText As String, Optional ByVal toastTitle As String, Optional ByVal toastLogoPath As String)
    Dim PSOptions As String
    PSOptions = " -WindowStyle hidden -ExecutionPolicy bypass -NonInteractive"
    
    Dim PSCommand As String
    PSCommand = "powershell.exe" & PSOptions & " -File " & PopToastPath & " -cmdText """ & toastText & """"
    If Not Trim$(toastTitle) = vbNullString Then PSCommand = PSCommand & " -cmdTitle """ & toastTitle & """"
    If Not Trim$(toastLogoPath) = vbNullString Then PSCommand = PSCommand & """ -cmdLogo """ & toastLogoPath & """"

    With CreateObject("Wscript.Shell")
        .Run PSCommand, 0, False
    End With
End Sub

---

注意：您可以配置应用程序名和appID，使toast看起来来自您自己的应用程序。如果您不这样做，那么它将被视为来自PowerShell。

很好！如果您可以发布DLL源代码，那将很有帮助。或者在回答中的代码中添加一个描述参数的函数头（例如，我不确定

iANIME\u DIRECTION

的作用）。谢谢。@Andre我已经添加了参数列表。我将把DLL上传到GitHub，并在下一篇文章中提供链接，当我介绍“如何从vba中访问.NETDLL”时，这是一件非常好的事情，谢谢！看起来它在64位office下不工作。您可以制作64位版本的DLL吗？另外，最好再添加一个选项—如果鼠标指针位于土司上方，则不要按计时器关闭土司。@SergeyS。添加了64位Dll，你能测试一下吗？还添加了鼠标事件，发布了指向我的项目的github链接。感谢快速更新，它现在显示在64下，但方式有点不同：如果在第一个toast消失之前打开第二个toast，则会显示第二个toast，但第一个toast会立即消失，所以在屏幕上只能看到一个祝酒词。如果有像我这样的人不知道“祝酒词”：我相信如果你上传源代码，会有很多人提供帮助。您的github页面上只发布了二进制文件。

Please do improve: 

## Pop-Toast 
#Requires -Version 5
Param (
    [String]$cmdText="Test",
    [String]$cmdTitle="Example",
    [String]$cmdLogo="$PSScriptRoot\YourLogo.ico",
    [String]$thisApplication,
    [String]$appID
)



## Ensure we have the latest version of our module installed
$toastModule = "BurntToast"
if (Get-Module -ListAvailable -Name $toastModule) {
    # If you uncomment the next line it will update but each call is much slower.
    #Update-Module -Name $toastModule
} 
else {
    try {
        Install-Module -Name $toastModule -AllowClobber -Confirm:$False -Force  
    }
    catch [Exception] {
        $_.message 
        exit
    }
}

## Pop that tart!
$header = New-BTHeader -Id $appID -Title $thisApplication
New-BurntToastNotification -AppLogo $cmdLogo -Header $header -AppId $appID -Text $cmdTitle, $cmdText 

Const PopToastPath As String = "Toast\Pop-Toast.ps1"

Public Sub PopToaster(ByVal toastText As String, Optional ByVal toastTitle As String, Optional ByVal toastLogoPath As String)
    Dim PSOptions As String
    PSOptions = " -WindowStyle hidden -ExecutionPolicy bypass -NonInteractive"
    
    Dim PSCommand As String
    PSCommand = "powershell.exe" & PSOptions & " -File " & PopToastPath & " -cmdText """ & toastText & """"
    If Not Trim$(toastTitle) = vbNullString Then PSCommand = PSCommand & " -cmdTitle """ & toastTitle & """"
    If Not Trim$(toastLogoPath) = vbNullString Then PSCommand = PSCommand & """ -cmdLogo """ & toastLogoPath & """"

    With CreateObject("Wscript.Shell")
        .Run PSCommand, 0, False
    End With
End Sub