This post will show you/guide you on how to use VBA to show System Tray Balloon Notification using VBA.
Click here for explainer video below with VBA code.
Create an Excel UserForm and name it NotifyFr. and add 2 buttons with names CommandButton1 and CommandButton2. They should have this name by default if not rename them using properties window.
Add any .ico file in the same folder where you have this project saved and name it PerfCenterCpl.ico
This file will be used as an ico when your notification shows up in-tray.
Paste below code in ThisWorkbook module by double-clicking ThisWorkbook from VBE editor.
Click here for explainer video below with VBA code.
Create an Excel UserForm and name it NotifyFr. and add 2 buttons with names CommandButton1 and CommandButton2. They should have this name by default if not rename them using properties window.
Add any .ico file in the same folder where you have this project saved and name it PerfCenterCpl.ico
This file will be used as an ico when your notification shows up in-tray.
Paste below code in ThisWorkbook module by double-clicking ThisWorkbook from VBE editor.
Option Explicit
Private Sub Workbook_Open()
Application.EnableEvents = True
ShowMsg "VBA Bytes Add-in loaded successfully..."
End Sub
Paste below code in UserForm module.
Private Sub CommandButton1_Click()
Unload Me
ThisWorkbook.Close
End Sub
Private Sub CommandButton2_Click()
Unload Me
ThisWorkbook.Close
End Sub
Private Sub UserForm_Activate()
Me.Hide
RemoveIconFromTray
Unhook
Dim Me_hWnd As Long, Me_Icon As Long, Me_Icon_Handle As Long, IconPath As String
IconPath = IconPathx
Me_hWnd = FindWindowd("ThunderDFrame", Me.Caption)
Me_Icon_Handle = ExtractIcond(0, IconPath, 0)
Hook Me_hWnd
AddIconToTray Me_hWnd, 0, Me_Icon_Handle, "Double Click to re-open userform"
BalloonPopUp_1
Unload Me
End Sub
Private Sub UserForm_Initialize()
Me.Hide
End Sub
Now add / Insert new module and paste the below code to it.
Option Explicit
'-----------------------------
'Thanks for downloading the code.
'Please visit our channel for a quick explainer on this code.
'Feel free to update the code as per your need and also share with your friends.
'Channel: Youtube.com/vbaa2z
'Download free codes from http://vbaa2z.blogspot.com
'Autor: L Pamai (vbaa2z.team@gmail.com)
'-----------------------------
Declare Function SetForegroundWindow Lib "user32" (ByVal hWnd As Long) As Long
Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Long
Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal
lParam As Long) As Long
Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Declare Function ExtractIcon Lib "shell32.dll" Alias "ExtractIconA" (ByVal hInst As Long, ByVal lpszExeFileName As String, ByVal nIconIndex As Long) As Long
Public Const WM_LBUTTONDOWN = &H201
Public Const WM_LBUTTONUP = &H202
Public Const WM_LBUTTONDBL = &H203
Public Const WM_RBUTTONDOWN = &H204
Public Const WM_RBUTTONUP = &H205
Public Const WM_RBUTTONDBL = &H206
Public Const WM_ACTIVATEAPP = &H1C
Public Const NIS_HIDDEN = &H1
Public Const NIS_SHAREDICON = &H2
Public Const NIF_ICON = &H2
Public Const NIF_MESSAGE = &H1
Public Const NIF_TIP = &H4
Public Const NIF_STATE = &H8
Public Const NIF_INFO = &H10
Public Const NIM_ADD = &H0
Public Const NIM_MODIFY = &H1
Public Const NIM_DELETE = &H2
Public Const WM_MOUSEMOVE = &H200
Public Const MAX_TOOLTIP As Integer = 128
Public Const GWL_WNDPROC = (-4)
'shell version / NOTIFIYICONDATA struct size constants
Public Const NOTIFYICONDATA_V1_SIZE As Long = 88 'pre-5.0 structure size
Public Const NOTIFYICONDATA_V2_SIZE As Long = 488 'pre-6.0 structure size
Public Const NOTIFYICONDATA_V3_SIZE As Long = 504 '6.0+ structure size
Public NOTIFYICONDATA_SIZE As Long
Type NOTIFYICONDATA
cbSize As Long
hWnd As Long
uID As Long
uFlags As Long
uCallbackMessage As Long
hIcon As Long
szTip As String * MAX_TOOLTIP
dwState As Long
dwStateMask As Long
szInfo As String * 256
uTimeout As Long
szInfoTitle As String * 64
dwInfoFlags As Long
End Type
Public nfIconData As NOTIFYICONDATA
' list the icon types for the balloon message..
Public Const vbNone = 0
Public Const vbInformation = 1
Public Const vbExclamation = 2
Public Const vbCritical = 3
Public MessageX As String
Private FHandle As Long
Private WndProc As Long
Private Hooking As Boolean
Public Sub Hook(Lwnd As Long)
If Hooking = False Then
FHandle = Lwnd
WndProc = SetWindowLong(Lwnd, GWL_WNDPROC, AddressOf WindowProc)
Hooking = True
End If
End Sub
Public Sub Unhook()
If Hooking = True Then
SetWindowLong FHandle, GWL_WNDPROC, WndProc
Hooking = False
End If
End Sub
Public Function WindowProc(ByVal hw As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
If Hooking Then
If lParam = WM_LBUTTONDBL Then
NotifyFr.Show 1
WindowProc = True
' Unhook
Exit Function
End If
WindowProc = CallWindowProc(WndProc, hw, uMsg, wParam, lParam)
End If
End Function
Public Sub RemoveIconFromTray()
Shell_NotifyIcon NIM_DELETE, nfIconData
End Sub
Public Sub AddIconToTray(MeHwnd As Long, MeIcon As Long, MeIconHandle As Long, Tip As String)
With nfIconData
.hWnd = MeHwnd
.uID = MeIcon
.uFlags = NIF_MESSAGE Or NIF_ICON Or NIF_TIP
.uCallbackMessage = WM_RBUTTONUP
.dwState = NIS_SHAREDICON
.hIcon = MeIconHandle
.szTip = Tip & Chr$(0)
.cbSize = NOTIFYICONDATA_V3_SIZE
End With
Shell_NotifyIcon NIM_ADD, nfIconData
End Sub
Function FindWindowd(ByVal lpClassName As String, ByVal lpWindowName As String) As Long
FindWindowd = FindWindow(lpClassName, lpWindowName)
End Function
Function ExtractIcond(ByVal hInst As Long, ByVal lpszExeFileName As String, ByVal nIconIndex As Long) As Long
ExtractIcond = ExtractIcon(hInst, lpszExeFileName, nIconIndex)
End Function
'this is the part you need to pay attention to :)
Sub test1()
ShowMsg "VBA Bytes Add-in loaded successfully..."
End Sub
Sub test2()
ShowMsg "This is second message."
End Sub
Function ShowMsg(xmsg As String) As Boolean
MessageX = xmsg
NotifyFr.Show 1
End Function
Public Sub BalloonPopUp_1()
With nfIconData
.dwInfoFlags = vbInformation
.uFlags = NIF_INFO
.szInfoTitle = "VBA Bytes" & vbNullChar
.szInfo = MessageX & vbNullChar
End With
Shell_NotifyIcon NIM_MODIFY, nfIconData
End Sub
Public Function IconPathx() As String
IconPathx = ThisWorkbook.Path & "\PerfCenterCpl.ico"
End Function
Now to test this simple try running sub test1 or test2 or Workbook_Open code. have fun and reach out to me if you have any questions.
great!
ReplyDelete