Create system tray alerts in Access

Status
Not open for further replies.
isladogs

isladogs

MVP / VIP
Local time
Today, 17:58
Joined
Jan 14, 2017
Messages
18,534
This database demonstrates how you can use Access to create popup messages in the system tray notifications area. This is ideal if you want to alert users to issues such as:
• Product support or licence about to expire
• A new version available on the program website

The idea for this project came from the following thread:
https://www.access-programmers.co.uk/forums/showthread.php?t=294849

The balloon tooltips code is not mine - if anyone recognises it as their own work, please let me know & I will add your details to the code

The main form in the DEMO database is shown below:

attachment.php


Popup messages similar to these will be displayed in the system tray notifications area

attachment.php


attachment.php


NOTE Screenshots done in Windows 10. Messages look different in earlier Windows versions
===============================================

To use this code with your own databases:

1. Add the VBA reference 'Microsoft Internet Controls'
2. Import and adapt the table tblLocalVariables
Alternatively, adapt the code to use similar data in another table of your own
3. Import all 5 modules
4. Modules modFunctions & modInternetDownload are used for the version check
The main version check code is contained in the procedure: CheckLatestWebVersion in modFunctions.
This ‘reads’ the contents of a specified webpage to a temporary text file and searches it for a specified string from which the web version number is extracted
The web version is then compared with the local version number
You will need to ADAPT the code as necessary to suit your own database and website
5. The form also contains a non ActiveX calendar form frmDatePicker which will work in 32-bit or 64-bit Access. The code for this is in modDatePicker
6. The balloon tooltips code is contained in a standard module modBalloonTooltip and a class module BalloonTooltip.
Copy both modules to your project to use this idea

Each message needs a single line of code e.g.

Code: 
ShowBalloonTooltip "INFO - New version available", GetProgramName() & " version " & intWebVer 
& " is available for download from the " & GetCompanyName() & " website", btWarning

An extra form frmBalloonTooltip is also provided so you can test the functionality for yourself:

For further information, see the attached PDF file (zipped)
If you have any questions, respond to this thread or send me a PM.

NOTE: the balloon tooltips code doesn't work in 64-bit Access. I will investigate this further at some point in the future
 

Attachments

Last edited:
Hello,
I tested the example with Win 10 64 bit and Office 2016 64 bit and it did not work.
I tested with Win 10 and Office 2016 32 bit and it also did not work.
It did not show any error and I even changed some API's to run in 64 bits, but without success.
Do you have any suggestions?

Thank you

Greetings from Brazil

Marcelo
 
Thanks a lot for the nice example,
I am wondering whether there is a way to
* change the Foregrround /BackGround colors (Black on yellow) of the tray
alert window also its

* to be able to click the icon in the tray (after disappearing of the alert) to retain
the last message

Thanks again and have a nice day
(01 May is the day of work)
 
ridders said:
This database demonstrates how you can use Access to create popup messages in the system tray notifications area. This is ideal if you want to alert users to issues such as:
• Product support or licence about to expire
• A new version available on the program website

The idea for this project came from the following thread:
https://www.access-programmers.co.uk/forums/showthread.php?t=294849

The balloon tooltips code is not mine - if anyone recognises it as their own work, please let me know & I will add your details to the code

The main form in the DEMO database is shown below:

attachment.php


Popup messages similar to these will be displayed in the system tray notifications area

attachment.php


attachment.php


NOTE Screenshots done in Windows 10. Messages look different in earlier Windows versions
===============================================

To use this code with your own databases:

1. Add the VBA reference 'Microsoft Internet Controls'
2. Import and adapt the table tblLocalVariables
Alternatively, adapt the code to use similar data in another table of your own
3. Import all 5 modules
4. Modules modFunctions & modInternetDownload are used for the version check
The main version check code is contained in the procedure: CheckLatestWebVersion in modFunctions.
This ‘reads’ the contents of a specified webpage to a temporary text file and searches it for a specified string from which the web version number is extracted
The web version is then compared with the local version number
You will need to ADAPT the code as necessary to suit your own database and website
5. The form also contains a non ActiveX calendar form frmDatePicker which will work in 32-bit or 64-bit Access. The code for this is in modDatePicker
6. The balloon tooltips code is contained in a standard module modBalloonTooltip and a class module BalloonTooltip.
Copy both modules to your project to use this idea

Each message needs a single line of code e.g.

Code: 
ShowBalloonTooltip "INFO - New version available", GetProgramName() & " version " & intWebVer 
& " is available for download from the " & GetCompanyName() & " website", btWarning

An extra form frmBalloonTooltip is also provided so you can test the functionality for yourself:

For further information, see the attached PDF file (zipped)
If you have any questions, respond to this thread or send me a PM.

NOTE: the balloon tooltips code doesn't work in 64-bit Access. I will investigate this further at some point in the future
Click to expand...


Hi,
I think this is an extra bit for 64 bit that could be handy :
Code: 
Option Compare Database
Option Explicit

Private mlngIcon As Long
Private mstrHeading As String
Private mstrMessage As String

Private Const APP_SYSTRAY_ID = 999

Private Const NOTIFYICON_VERSION = &H3

Private Const NIF_MESSAGE = &H1
Private Const NIF_ICON = &H2
Private Const NIF_TIP = &H4
Private Const NIF_STATE = &H8
Private Const NIF_INFO = &H10

Private Const NIM_ADD = &H0
Private Const NIM_MODIFY = &H1
Private Const NIM_DELETE = &H2
Private Const NIM_SETFOCUS = &H3
Private Const NIM_SETVERSION = &H4
Private Const NIM_VERSION = &H5

Private Const NIS_HIDDEN = &H1
Private Const NIS_SHAREDICON = &H2

Private Const NIIF_NONE = &H0
Private Const NIIF_INFO = &H1
Private Const NIIF_WARNING = &H2
Private Const NIIF_ERROR = &H3
Private Const NIIF_GUID = &H5
Private Const NIIF_ICON_MASK = &HF
Private Const NIIF_NOSOUND = &H10
   
Private Const WM_USER = &H400
Private Const NIN_BALLOONSHOW = (WM_USER + 2)
Private Const NIN_BALLOONHIDE = (WM_USER + 3)
Private Const NIN_BALLOONTIMEOUT = (WM_USER + 4)
Private Const NIN_BALLOONUSERCLICK = (WM_USER + 5)

Private Const NOTIFYICONDATA_V1_SIZE As Long = 88
Private Const NOTIFYICONDATA_V2_SIZE As Long = 488
Private Const NOTIFYICONDATA_V3_SIZE As Long = 504
Private NOTIFYICONDATA_SIZE As Long

Private Type GUID
   Data1 As Long
   Data2 As Integer
   Data3 As Integer
   Data4(7) As Byte
End Type
#If VBA7 Then
Private Type NOTIFYICONDATA
  cbSize As Long
  hwnd As LongPtr
  uID As Long
  uFlags As Long
  uCallbackMessage As Long
  hIcon As LongPtr
  szTip As String * 128
  dwState As Long
  dwStateMask As Long
  szInfo As String * 256
  uTimeoutAndVersion As Long
  szInfoTitle As String * 64
  dwInfoFlags As Long
  guidItem As GUID
End Type
#Else
Private Type NOTIFYICONDATA
  cbSize As Long
  hwnd As Long
  uID As Long
  uFlags As Long
  uCallbackMessage As Long
  hIcon As Long
  szTip As String * 128
  dwState As Long
  dwStateMask As Long
  szInfo As String * 256
  uTimeoutAndVersion As Long
  szInfoTitle As String * 64
  dwInfoFlags As Long
  guidItem As GUID
#End If


#If VBA7 Then

Private Declare PtrSafe Function Shell_NotifyIcon Lib "shell32.dll" _
   Alias "Shell_NotifyIconA" _
  (ByVal dwMessage As LongPtr, _
   lpData As NOTIFYICONDATA) As LongPtr

Private Declare PtrSafe Function GetFileVersionInfoSize Lib "version.dll" _
   Alias "GetFileVersionInfoSizeA" _
  (ByVal lptstrFilename As String, _
   lpdwHandle As Long) As Long

Private Declare PtrSafe Function GetFileVersionInfo Lib "version.dll" _
   Alias "GetFileVersionInfoA" _
  (ByVal lptstrFilename As String, _
   ByVal dwHandle As LongPtr, _
   ByVal dwLen As LongPtr, _
   lpData As Any) As Long
   
Private Declare PtrSafe Function VerQueryValue Lib "version.dll" _
   Alias "VerQueryValueA" _
  (pBlock As Any, _
   ByVal lpSubBlock As String, _
   lpBuffer As Any, _
   nVerSize As Long) As LongPtr

Private Declare PtrSafe Sub CopyMemory Lib "kernel32" _
   Alias "RtlMoveMemory" _
  (Destination As Any, _
   Source As Any, _
   ByVal Length As LongPtr)
#Else
Private Declare Function Shell_NotifyIcon Lib "shell32.dll" _
   Alias "Shell_NotifyIconA" _
  (ByVal dwMessage As Long, _
   lpData As NOTIFYICONDATA) As Long

Private Declare Function GetFileVersionInfoSize Lib "version.dll" _
   Alias "GetFileVersionInfoSizeA" _
  (ByVal lptstrFilename As String, _
   lpdwHandle As Long) As Long

Private Declare Function GetFileVersionInfo Lib "version.dll" _
   Alias "GetFileVersionInfoA" _
  (ByVal lptstrFilename As String, _
   ByVal dwHandle As Long, _
   ByVal dwLen As Long, _
   lpData As Any) As Long
   
Private Declare Function VerQueryValue Lib "version.dll" _
   Alias "VerQueryValueA" _
  (pBlock As Any, _
   ByVal lpSubBlock As String, _
   lpBuffer As Any, _
   nVerSize As Long) As Long

Private Declare Sub CopyMemory Lib "kernel32" _
   Alias "RtlMoveMemory" _
  (Destination As Any, _
   Source As Any, _
   ByVal Length As Long)
#End If

Private Const WM_GETICON = &H7F
                                 
Private Const WM_SETICON = &H80
Private Const IMAGE_BITMAP = 0
Private Const IMAGE_ICON = 1
Private Const IMAGE_CURSOR = 2
Private Const LR_LOADFROMFILE = &H10
                                          
Private Const ICON_SMALL = 0&
Private Const ICON_BIG = 1&

#If VBA7 Then

Private Declare PtrSafe Function apiLoadImage Lib "user32" _
   Alias "LoadImageA" _
   (ByVal hInst As LongPtr, _
   ByVal lpszName As String, _
   ByVal uType As LongPtr, _
   ByVal cxDesired As LongPtr, _
   ByVal cyDesired As LongPtr, _
   ByVal fuLoad As LongPtr) _
   As Long

Private Declare PtrSafe Function apiSendMessageLong Lib "user32" _
   Alias "SendMessageA" _
   (ByVal hwnd As LongPtr, _
   ByVal wMsg As Long, _
   ByVal wParam As LongPtr, _
   ByVal lParam As LongPtr) _
   As LongPtr
#Else
Private Declare Function apiLoadImage Lib "user32" _
   Alias "LoadImageA" _
   (ByVal hInst As Long, _
   ByVal lpszName As String, _
   ByVal uType As Long, _
   ByVal cxDesired As Long, _
   ByVal cyDesired As Long, _
   ByVal fuLoad As Long) _
   As Long

Private Declare Function apiSendMessageLong Lib "user32" _
   Alias "SendMessageA" _
   (ByVal hWnd As Long, _
   ByVal wMsg As Long, _
   ByVal wParam As Long, _
   ByVal lParam As Long) _
   As Long
#End If
Private Const SHGFI_ICON = &H100
Private Const SHGFI_DISPLAYNAME = &H200
Private Const SHGFI_TYPENAME = &H400
Private Const SHGFI_ATTRIBUTES = &H800
Private Const SHGFI_ICONLOCATION = &H1000

Private Const FILE_ATTRIBUTE_NORMAL = &H80
Private Const MAX_PATH = 260

Private Type SHFILEINFO
   hIcon As LongPtr
   iIcon As LongPtr
   dwAttributes As LongPtr
   szDisplayName As String * MAX_PATH
   szTypeName As String * 80
End Type

#If VBA7 Then
Private Declare PtrSafe Function apiSHGetFileInfo Lib "shell32.dll" _
   Alias "SHGetFileInfoA" _
   (ByVal pszPath As String, _
    ByVal dwFileAttributes As LongPtr, _
    psfi As SHFILEINFO, _
    ByVal cbSizeFileInfo As LongPtr, _
    ByVal uFlags As LongPtr) _
    As LongPtr
        
Private Declare PtrSafe Function apiDestroyIcon Lib "user32" _
   Alias "DestroyIcon" _
   (ByVal hIcon As LongPtr) _
   As LongPtr
#Else
Private Declare Function apiSHGetFileInfo Lib "shell32.dll" _
   Alias "SHGetFileInfoA" _
   (ByVal pszPath As String, _
    ByVal dwFileAttributes As Long, _
    psfi As SHFILEINFO, _
    ByVal cbSizeFileInfo As Long, _
    ByVal uFlags As Long) _
    As Long
        
Private Declare Function apiDestroyIcon Lib "user32" _
   Alias "DestroyIcon" _
   (ByVal hIcon As Long) _
   As Long
#End If

Private psfi As SHFILEINFO

Private Const SW_HIDE = 0
Private Const SW_SHOWNORMAL = 1
Private Const SW_SHOWMINIMIZED = 2
Private Const SW_SHOWMAXIMIZED = 3

#If VBA7 Then
Private Declare PtrSafe Function apiShowWindow Lib "user32" _
   Alias "ShowWindow" _
   (ByVal hwnd As LongPtr, _
   ByVal nCmdShow As LongPtr) _
   As LongPtr
#Else
Private Declare Function apiShowWindow Lib "user32" _
   Alias "ShowWindow" _
   (ByVal hWnd As Long, _
   ByVal nCmdShow As Long) _
   As Long
#End If

Private Sub ShellTrayAdd()
   
   Dim nID As NOTIFYICONDATA
   
   If NOTIFYICONDATA_SIZE = 0 Then SetShellVersion
   
   With nID
   
      .cbSize = NOTIFYICONDATA_SIZE
      .hwnd = Application.hWndAccessApp
      
      .uID = APP_SYSTRAY_ID
      .uFlags = NIF_MESSAGE Or NIF_ICON Or NIF_TIP
      .dwState = NIS_SHAREDICON
      .hIcon = fSetIcon(GetAppIcon)
      
      .szTip = "DHLGM Message Service" & vbNullChar
      .uTimeoutAndVersion = NOTIFYICON_VERSION
      
   End With
   
   Call Shell_NotifyIcon(NIM_ADD, nID)
   
   Call Shell_NotifyIcon(NIM_SETVERSION, nID)
       
End Sub

Private Sub ShellTrayRemove()

   Dim nID As NOTIFYICONDATA
   
   If NOTIFYICONDATA_SIZE = 0 Then SetShellVersion
      
   With nID
      .cbSize = NOTIFYICONDATA_SIZE
      .hwnd = Application.hWndAccessApp
      .uID = APP_SYSTRAY_ID
   End With
   
   Call Shell_NotifyIcon(NIM_DELETE, nID)
   Call apiDestroyIcon(nID.hIcon)
End Sub

Private Sub ShellTrayModifyTip(nIconIndex As Long)

   Dim nID As NOTIFYICONDATA

   If NOTIFYICONDATA_SIZE = 0 Then SetShellVersion
   
   With nID
      .cbSize = NOTIFYICONDATA_SIZE
      .hwnd = Application.hWndAccessApp
      .uID = APP_SYSTRAY_ID
      .uFlags = NIF_INFO
      .dwInfoFlags = nIconIndex
      
      .szInfoTitle = mstrHeading & vbNullChar
      .szInfo = mstrMessage & vbNullChar
   End With

   Call Shell_NotifyIcon(NIM_MODIFY, nID)

End Sub

Private Sub SetShellVersion()

   Select Case True
      Case IsShellVersion(6)
         NOTIFYICONDATA_SIZE = NOTIFYICONDATA_V3_SIZE
      
      Case IsShellVersion(5)
         NOTIFYICONDATA_SIZE = NOTIFYICONDATA_V2_SIZE
      
      Case Else
         NOTIFYICONDATA_SIZE = NOTIFYICONDATA_V1_SIZE
   End Select

End Sub

Private Function IsShellVersion(ByVal version As LongPtr) As Boolean

   Dim nBufferSize As Long
   Dim nUnused As Long
   Dim lpBuffer As LongPtr
   Dim nVerMajor As Integer
   Dim bBuffer() As Byte
   
   Const sDLLFile As String = "shell32.dll"
   
   nBufferSize = GetFileVersionInfoSize(sDLLFile, nUnused)
   
   If nBufferSize > 0 Then
    
      ReDim bBuffer(nBufferSize - 1) As Byte
    
      Call GetFileVersionInfo(sDLLFile, 0&, nBufferSize, bBuffer(0))
    
      If VerQueryValue(bBuffer(0), "\", lpBuffer, nUnused) = 1 Then
         
         CopyMemory nVerMajor, ByVal lpBuffer + 10, 2
        
         IsShellVersion = nVerMajor >= version
      
      End If
    
   End If
  
End Function

Private Function GetSelectedOptionIndex() As LongPtr

    GetSelectedOptionIndex = 2
                            
End Function

Public Property Get Icon() As btIcon
    Icon = mlngIcon
End Property

Public Property Let Icon(ByVal lngIcon As btIcon)
    mlngIcon = lngIcon
End Property

Public Property Get Heading() As String
    Heading = mstrHeading
End Property

Public Property Let Heading(ByVal strHeading As String)
    mstrHeading = strHeading
End Property

Public Property Get Message() As String
    Message = mstrMessage
End Property

Public Property Let Message(ByVal strMessage As String)
    mstrMessage = strMessage
End Property

Public Sub Show()
       Call ShellTrayAdd
       ShellTrayModifyTip mlngIcon
End Sub

Public Sub Hide()
   ShellTrayRemove
End Sub

Private Function fSetIcon(strIconPath As String) As Long
Dim hIcon As Long
   hIcon = apiLoadImage(0&, strIconPath, IMAGE_ICON, 16&, 16&, LR_LOADFROMFILE)
   If hIcon Then
      fSetIcon = hIcon
   End If
End Function

Public Function GetAppIcon() As String
    Dim dbs As DAO.Database, prp As Property
    Const conPropNotFoundError = 3270
    On Error GoTo GetAppIcon_Error
   
    Beep
    Set dbs = CurrentDb
    GetAppIcon = dbs.Properties("AppIcon")

ExitHere:
   Exit Function

GetAppIcon_Error:

    Select Case Err.Number
    Case 3270 'PropertyC Not Found
        'db doesn't have an associated icon - no message needed
       ' MsgBox "Current Database needs to have a custom icon", vbCritical, "No Icon Found"
        Resume ExitHere
    Case Else
        MsgBox "An Unexpected Error has occured please inform IT Support Error " & Err.Number & " " & Err.Description & " in procedure GetAppIcon of Class Module BalloonTooltip", vbCritical, "db2"
        Resume ExitHere
    End Select
    'Debug Only
    Resume

End Function

Regards,
Margarit
 
Attached is an updated version of this utility which. I'm pleased to say, now also works in 64-bit Access.

The only change is to the class module BalloonTooltip

Many thanks to riti90 for doing the majority of the conversion to 64-bit code
 

Attachments

ridders said:
Attached is an updated version of this utility which. I'm pleased to say, now also works in 64-bit Access.

The only change is to the class module BalloonTooltip

Many thanks to riti90 for doing the majority of the conversion to 64-bit code
Click to expand...
Hello Brother, is there any way to get it by PM? cause i need that 64-bit Modulo :c ty !
 
The following posts have all just been approved
#2 - lelo28 (I've removed 2 duplicate posts)
#3 - el-alcaide
#4 - riti90
#6 - juleehz

@lelo28
Post #1 clearly stated it didn't work in 64-bit Access. That was fixed in post #5 with the assistance of riti90

@el-alcaide
The appearance of the alert is determined by Windows and is different in Win7 to that in Win10. No idea what its like in Win8 as i never used it.
I don't know of any way of modifying the colours
Similarly it seems that the alerts cannot be made interactive using VBA...though I would be very happy if anyone can work out how to do so

riti90
Once again thanks for your help. Changes included in post #5

juleehz
Just download it from post #5
 
Last edited:
on 5# post...

Attachments Pending Approval
zip.gif
SystemTrayAlert_v1.5.zip
 
Apologies. Approved now & posting to trigger email notifications
 
Ridders, thanks a lot for your example and including the 64-bit version.
Have a nice day.
 
Just something I noticed...

The "Support Expiry Date" field.... if you change it via the date picker it does display the date you choose in the field but does not generate the new system tray message.

If you manually change the date in the field and then click on the form outside the field it will popup the new system tray alert with the changed date.

I also noticed there was no system tray icon below the message.

I don't know if that is how it is supposed to act.
 
Last edited:
Thanks for your message
I can confirm its no longer working for me either - tested in Windows 10 v1709 (but one which had v1803 installed and then removed)

I've also tried my Attention Seeking database in sample databases which includes the same feature AND two other similar utilities written by others.

In each case, all I see is a brief flash as an icon is added to the notifications area but no alert message

So either a Windows update or Access update must have broken the feature in the last month.

I'll post to a standard forum area to try & get feedback from others before looking into the cause
 
Colin,
I know I am only on 2007, but I found an End Type missing in BalloonToolTip for Private Type NOTIFYICONDATA when I downloaded from link in post #5?
 
Well spotted Gasman
I've added the missing line in the class module declarations
Version 1.6 attached - no other changes made

Can you let me know if this is now working for you

However it hasn't fixed the issue for me (tested on 2 PCs) and I haven't got time to look into it for a while.
I believe the problem is caused by a recent Office update as it (and other similar examples) worked a month ago
 

Attachments

V1.6
On my laptop in work.
It now starts up OK and if I use Check Website I get told a later version is available.
However if I try the date picker I get error in frmDatePicker - DrawDateButtons of 'Compile Error - Method or data member not found' on
Code: 
btn.BackColor = ColLemon

I have no missing references.

However not sure I tested this previously?
 
Paul

When you click check for updates you should see two things. A message box AND a system try alert. It's the latter that has stopped working for me and the person who reported it. Are you seeing both events?

The ColLemon line is just setting the background colour in the date picker. It works fine in A2010 & A2016.
I use the same form in the 'Better Date Picker' utility.

BTW as this is a moderated area, suggest any further replies are instead done in this thread
https://www.access-programmers.co.uk/forums/showthread.php?t=300505
 
Last edited:
Further update / clarification

Users should see messages similar to this is the system tray (or notifications) area at the bottom right of the screen

attachment.php


That's for Windows 10 - it looks different in Win 7 / Win 8
However, some people report it just goes straight to the notifications banner area

For the alert to work, you need to ensure you switch on notifications from Access in Windows settings

attachment.php


Also I've just realised why it wasn't working for me yesterday - in a recent Windows update, the Quiet Hours feature was added

attachment.php


When this is enabled (normally in evening & overnight), no notifications appear. Switch it off & they return! Doh!
 
Is it possible to send a message in system tray (or notifications) areato a specific user running on the server?
 
Hi drakopp
You could build in code that means an alert will only be seen by a specific user.

AFAIK you can't use this as a messenging feature.
However there are other ways of doing that in Access
 
Status
Not open for further replies.

Similar threads

T
Solved Can't find System DSN after upgrading to Office 365
Replies
18
Views
361
sonic8
S
A
Using ACCDE format 64 vs 32 bits
Replies
10
Views
440
The_Doc_Man
The_Doc_Man
D
Default Signature new outlook current user
Replies
17
Views
361
GPGeorge
GPGeorge
B
Solved NewEnum Crashes Access
Replies
10
Views
558
backcountryprogrammer
B
zelarra821
Filter mail in Outlook
Replies
1
Views
628
zelarra821
zelarra821

Users who are viewing this thread

Total: 1 (members: 0, guests: 1)
Back
Top Bottom