Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Курилка
Страницы: 1
RSS
VBA. Вывод сообщения в системный трей Windows, Два варианта кода: попроще и сложный
 
#1
03.12.2021 17:47:27
Кто пользуется торрентом, к примеру как я, тот часто видит уведомление такого типа:

Кому интересно, как это сделать на vba, вот код попроще(Module2):
Код
Public Function Notify(ByVal title As String, ByVal msg As String, _
        Optional ByVal notification_icon As String = "Info", _
        Optional ByVal app As String = "excel", _
        Optional ByVal duration As Integer = 10)

    'Parameters:
    '    title (str):Notification title
    '    msg (str):Notification message
    '    notification_icon (str):Notification icon. Available options are: Info, Error and Warning
    '    app (str):Process name of app you want to be display in the system tray icon
    '    duration (int):Duration of notification in seconds

    Const PSpath    As String = "powershell.exe"

    Dim WsShell     As Object: Set WsShell = CreateObject("WScript.Shell")
    Dim strCommand  As String

    If notification_icon <> "Info" And notification_icon <> "Error" And notification_icon <> "Warning" Then
        notification_icon = "Info"
    End If

    strCommand = """" & PSpath & """ -Command " & Chr(34) & "& { "
    strCommand = strCommand & "Add-Type -AssemblyName 'System.Windows.Forms'"
    strCommand = strCommand & "; $notification = New-Object System.Windows.Forms.NotifyIcon"
    strCommand = strCommand & "; $path = (Get-Process -id (get-process " & app & ").id).Path"
    strCommand = strCommand & "; $notification.Icon = [System.Drawing.Icon]::ExtractAssociatedIcon($path)"
    strCommand = strCommand & "; $notification.BalloonTipIcon  = [System.Windows.Forms.ToolTipIcon]::" & notification_icon & ""
    strCommand = strCommand & "; $notification.BalloonTipText = '" & msg & "'"
    strCommand = strCommand & "; $notification.BalloonTipTitle = '" & title & "'"
    strCommand = strCommand & "; $notification.Visible = $true"
    strCommand = strCommand & "; $notification.ShowBalloonTip(" & duration & ")"
    strCommand = strCommand & " }" & Chr(34)

    WsShell.Run strCommand, 0, False

End Function

Public Sub Notify_Examples()

    Notify "Insert Title Here", "Insert Your Message Here"
'    Notify "Insert Title Here", "Insert Your Message Here", "Warning"
'    Notify "Insert Title Here", "Insert Your Message Here", "Error", "outlook"

End Sub

Сложный код см. в файле:
Изменено: DANIKOLA - 03.12.2021 17:53:57
 
 
 
#2
03.12.2021 18:27:46
Kaspersky не даёт запустить. Блокирует строку
Код
WsShell.Run strCommand, 0, False

и выскакивает ошибка 70 - Permission denied
А так прикольно
Изменено: New - 03.12.2021 18:29:56
 
 
 
#3
03.12.2021 20:18:24
New,  У меня Win7 64-bit, ноутбук, без антивируса, работают оба варианта. Позже проверю на 10-ке с антивирусом Eset.
Upd:
Цитата
DANIKOLA написал:
Позже проверю на 10-ке с антивирусом Eset
Проверил, все работает.

P.S. О, у Вас касперский, вот гляньте интересную статью о нем.
Изменено: DANIKOLA - 04.12.2021 10:35:48
 
 
 
#4
14.02.2022 00:53:04
Добрый день, не получается вывести сообщение в системный трей, кто знает как решить?

Скрин ошибки прикрепил
 
 
 
#5
15.02.2022 13:27:36
На рабочем ПК, где установлен Windows 10 ошибка не наблюдается, работает на отлично.
Дома у меня Windows 7...

Получилось сделать с помощью другого кода. Оставлю здесь, может быть кому-то пригодится.
Код
Option Explicit

Private Declare PtrSafe Function Shell_NotifyIconW Lib "shell32.dll" (ByVal dwMessage As Long, ByRef nfIconData As NOTIFYICONDATAW) As Long
Private Declare PtrSafe Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long)

Private Type NOTIFYICONDATAW
  cbSize As Long
#If Win64 Then
  padding1 As Long
#End If
  hwnd As LongPtr
  uID As Long
  uFlags As Long
  uCallbackMessage As Long
#If Win64 Then
  padding2 As Long
#End If
  hIcon As LongPtr
  szTip(1 To 128 * 2) As Byte
  dwState As Long
  dwStateMask As Long
  szInfo(1 To 256 * 2) As Byte
  uTimeout As Long
  szInfoTitle(1 To 64 * 2) As Byte
  dwInfoFlags As Long
End Type

Private Const NIM_ADD As Long = &H0&
Private Const NIM_MODIFY As Long = &H1&
Private Const NIF_INFO As Long = &H10&

Private Function Min(ByVal a As Long, ByVal b As Long) As Long
  If a < b Then Min = a Else Min = b
End Function

Public Sub Toast(Optional ByVal title As String, Optional ByVal info As String, Optional ByVal flag As Long)
  Dim nfIconData As NOTIFYICONDATAW
  
  info = info & " "
  title = title & " "
  With nfIconData
    .cbSize = Len(nfIconData)
    
    .uFlags = NIF_INFO
    .dwInfoFlags = flag
    
    If Len(title) > 0 Then
      CopyMemory ByVal VarPtr(.szInfoTitle(LBound(.szInfoTitle))), ByVal StrPtr(title), Min(Len(title) * 2, UBound(.szInfoTitle) - LBound(.szInfoTitle) + 1 - 2)
    End If
    
    If Len(info) > 0 Then
      CopyMemory ByVal VarPtr(.szInfo(LBound(.szInfo))), ByVal StrPtr(info), Min(Len(info) * 2, UBound(.szInfo) - LBound(.szInfo) + 1 - 2)
    End If
  End With
  
  Shell_NotifyIconW NIM_ADD, nfIconData
  Shell_NotifyIconW NIM_MODIFY, nfIconData
End Sub

Sub ShowSystemTrayMsg()
    
    Toast "title", "msg"

End Sub
 
 
 
#6
16.02.2022 16:50:55
Юрий Адамец, ваш вариант сработал у меня при включённом Касперском, как его изменить, чтобы сообщение не исчезало, пока пользователь сам не затронет или хотя бы простояло несколько больше времени?
 
 
 
#7
18.02.2022 16:11:30
Здравствуйте, Бахтиёр! Поиграйте с элементами структуры NOTIFYICONDATAW (там есть и таймаут, но он, вроде бы, для старых версий MS Windows) и сообщите нам о результате исследований, пожалуйста.
Изменено: sokol92 - 18.02.2022 18:20:22
Владимир
 
 
 
Страницы: 1
Наверх