popup message when new record added (1 Viewer)

murray83

Games Collector
Local time
Today, 17:33
Joined
Mar 31, 2017
Messages
728

isladogs

MVP / VIP
Local time
Today, 17:33
Joined
Jan 14, 2017
Messages
18,186
Suggest you post your solution for the benefit of anyone else who may want the same thing.

Having said that, if its a typical db with lots of tables, forms and indeed users, new records will be added (or edited) almost continuously.

I think there is a risk that the popup messages will drive people mad
 

murray83

Games Collector
Local time
Today, 17:33
Joined
Mar 31, 2017
Messages
728
Below is my solution hope this helps anyone in future

code when record added which i have inside a button press

Code:
'shows ballon tip for new record
ShowBalloonTooltip "New Move Request", "A New Request Has Been Placed", btInformation

following is the two modules needed

'class module BalloonTooltip
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

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 Type

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)

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&

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

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 Long
   iIcon As Long
   dwAttributes As Long
   szDisplayName As String * MAX_PATH
   szTypeName As String * 80
End Type

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

Private psfi As SHFILEINFO

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

Private Declare Function apiShowWindow Lib "user32" _
   Alias "ShowWindow" _
   (ByVal hWnd As Long, _
   ByVal nCmdShow As Long) _
   As Long

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 Long) As Boolean

   Dim nBufferSize As Long
   Dim nUnused As Long
   Dim lpBuffer As Long
   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 Long

    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 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
        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

'module called basBalloonTooltip
Code:
Option Compare Database
Option Explicit
Dim bt As BalloonTooltip

Public Enum btIcon
    btNone
    btInformation
    btWarning
    btCritical
End Enum


Public Function ShowBalloonTooltip(strHeading As String, strMessage As String, lngIcon As btIcon)
    'Wrapper function to call the class so it can be called from an add-in code library
    Set bt = New BalloonTooltip
    With bt
        .Heading = strHeading
        .Message = strMessage
        .Icon = lngIcon
        .Show
    End With
End Function


Public Function HideIcon()
    If Not bt Is Nothing Then
        With bt
            .Hide
        End With
    End If
End Function
 

CJ_London

Super Moderator
Staff member
Local time
Today, 17:33
Joined
Feb 19, 2013
Messages
16,553
A neat solution, but so far as I can see, only advises the person who clicked the button - so other than 'look/feel' what is the benefit over using a msgbox or a form that looks like a msgbox but has a timer to close after a few seconds?

I thought you were requiring a solution which when user A adds a new record, advises all other users that a record has been added. If this is the case, there would appear to be something missing
 

murray83

Games Collector
Local time
Today, 17:33
Joined
Mar 31, 2017
Messages
728
A neat solution, but so far as I can see, only advises the person who clicked the button -

sorry i think i may have been a bit early to say solved and i didn't read your reply quite right

as yes at the moment the record is just displayed for the user who clicks add

so my question is can this be done with a msg box or is it possible with balloon message for all users
 

Minty

AWF VIP
Local time
Today, 17:33
Joined
Jul 26, 2013
Messages
10,355
If the other users don't have the database open then the only route would be an external process running - as per your first post.

If they do have the database open then you could run some timer based code to check the number of records at time x then at time x + a period, and pop a notification up.

Both of these methods would have some significant overhead I suspect. And really annoy users after the first 10 minutes...
 

CJ_London

Super Moderator
Staff member
Local time
Today, 17:33
Joined
Feb 19, 2013
Messages
16,553
rather than using a balloon or msgbox, have a small form to open to display the message and in that forms timer event have some code to close the form after say 3 seconds.

The triggering of the form opening would be as Minty suggests, although I would suggest it needs to be on an event that the user triggers, otherwise the message may appear when the user is not at his desk and be gone by the time they return.

A suitable trigger event might be the navigation form got focus or activate event - or depending on msg content (say its about adding a new customer) a similar event on the customer form.

as far as the code for the trigger event, perhaps something like


Code:
sub trigger()
static rCount as long
dim tCount as long
 
    if rCount=0 then rCount=dcount("*","myTable") 'to initialise rCount
    tCount=dCount("*","myTable")
    if tCount<>rCount then
        msgbox tCount-rCount & " records have been added" 
        'or
        'docmd.openform "msgForm",,,,,,tCount-rCount & " records have been added" 
        rCount=tCount
    end if
 
end sub
and for your msgForm

open event
me.txtMessage=openargs
me.modal=false 'so users can carry on working while form is open
me.move 0 ,0 'so appears top left

timer event
docmd.close acform, "msgForm", acsaveno

other properties
timerinterval 3000
popup yes
modal yes
borderstyle none
navigationbuttons no
recordselectors no
scrollbars none

the above is off the top of my head, may needs some adjustment depending on requirements
 

isladogs

MVP / VIP
Local time
Today, 17:33
Joined
Jan 14, 2017
Messages
18,186
@Murray83

Although your solution isn't correct for the purpose you wanted, I thought I'd try your code to see if I could do anything with it

However I get a compile error on the following line in your standard module:
Code:
Dim bt As BalloonTooltip

Which reference library do you use for the BalloonTooltip?
 

isladogs

MVP / VIP
Local time
Today, 17:33
Joined
Jan 14, 2017
Messages
18,186
Thanks but I'd already tried that one (fm20.dll) & comctl32.ocx.
Its neither of those.
 

murray83

Games Collector
Local time
Today, 17:33
Joined
Mar 31, 2017
Messages
728
erm i just used this ( see attached )

also after some more searching have found this by CJ_London

Code:
Function anyInserted(tname as string)
static lastcount as long

if currentdb.tabledefs(tname).recordcount<>lastcount then
    if lastcount<>0 then msgbox "a record has been added to " & tname
    lastcount=currentdb.tabledefs(tname).recordcount
end if

end function

am i correct in thinking, if i were to place this in button click event for add record it would then display a message based on the record count if so which criteria would i change

do i need to change for instance the tname to the name of my table ?
 

Attachments

  • BalloonToolTipSample.mdb
    232 KB · Views: 518

isladogs

MVP / VIP
Local time
Today, 17:33
Joined
Jan 14, 2017
Messages
18,186
Thanks - I can see how it works in your example.

Perhaps I didn't copy it all from the earlier post ...
It does work when I copied the 2 modules from your example to a different db

I was expecting a balloon like message pop up but in Windows 10 it produces a message in the bottom right corner & adds it to the Action Centre

Oddly, the code requires that you set an application icon but doesn't display that icon in the notifications area...

Anyway, it could be useful at some point.
All I've got to do now is think of a use for it ;)
 

CJ_London

Super Moderator
Staff member
Local time
Today, 17:33
Joined
Feb 19, 2013
Messages
16,553
For the benefit of others reading this thread, the main code is a class module you need to name BalloonTooltip

No other libraries required

it pops out the windows notifier bottom right of the screen
 

isladogs

MVP / VIP
Local time
Today, 17:33
Joined
Jan 14, 2017
Messages
18,186
Also for the benefit of others....

Without thinking I had named the class module as clsBalloonTooltip.
That was why I got the compile error. My bad...

Also some icons will be displayed in the notifications area but not all those I tried.
If not shown, an empty space is left in the area.
Trial & error will get a working icon for this purpose
 

murray83

Games Collector
Local time
Today, 17:33
Joined
Mar 31, 2017
Messages
728
so could i do this using record count in the timer function and then display a msg box which says "New Record" ( or such ) and which will make the database form open on top of any other windows
 

CJ_London

Super Moderator
Staff member
Local time
Today, 17:33
Joined
Feb 19, 2013
Messages
16,553
also after some more searching have found this by CJ_London
Not sure if you are referring to the link you found to a post I made on another thread or the post I made on this thread - four posts before your 'discovery'

you can, but I really wouldn't use the timer function for this sort of monitoring for the reasons stated. Providing the form is popup and modal it will initially appear on top of all other windows.
 

murray83

Games Collector
Local time
Today, 17:33
Joined
Mar 31, 2017
Messages
728
ok but how would i get it done as tried the following

Code:
Dim varTotal As Integer
   Me.RecordsetClone.MoveLast
   varTotal = Me.RecordsetClone.RecordCount
   MsgBox "Number of loaded records: " & varTotal

which i found herehttps://access-programmers.co.uk/forums/showthread.php?t=124337 to count the records

as i belive this is the way to do it

count the records at the start and then when added new record it counts again and if the new figure is higher then display a message

would i need to have a base figure in a text box ?

answers please, ta all
 

CJ_London

Super Moderator
Staff member
Local time
Today, 17:33
Joined
Feb 19, 2013
Messages
16,553
No idea, that was not what I was suggesting. What you have provided is too small a snippet to determine if it will do what you want. On it's own, it is not sufficient.
 

murray83

Games Collector
Local time
Today, 17:33
Joined
Mar 31, 2017
Messages
728
No idea, that was not what I was suggesting. What you have provided is too small a snippet to determine if it will do what you want. On it's own, it is not sufficient.


ok how much bigger of a snippet would be good
 

Users who are viewing this thread

Top Bottom