Office 2010 VBA 7 Shell_NotifyIcon


  • I have developed a Financial CRM package and a Accounting Package in Office 2007...

    I am having a problem with Windows 7 64Bit Ultimate and Office 2010 64 bit - Taken my TrayIcon.Accdb which has worked fine in Office 2007 - added the usual PtrSafe pointers and corrected the LongLong And LongPtr Data Types but the following still adds no Icon to the tray... If anyone can help I have been searching for over a week now. If you need the full Database let me know... The Main Subs below... No Errors Just Nothing happens in the trayicon area.

    Public Sub ShowTrayIcon()
    Dim Retval As Long, lngLarge As Long, lngSmall As Long, lngIconIndex As Long

        If ProgPath = "" Then InitGlobals
        SetInsReg "fHandle", True, Access.hWndAccessApp
        IconPath = ProgPath & "\InsAcc.ico"
        Icon_Handle = ExtractIcond(0, IconPath, 0)
        Retval = ExtractIconEx(IconPath, lngIconIndex, lngLarge, lngSmall, 1)
        AddIconToTray Access.hWndAccessApp, Icon_Handle, lngSmall, "Insuria Accounts"
    End Sub

    Public Sub AddIconToTray(MeHwnd As Long, MeIcon As Long, MeIconHandle As Long, Tip As String)
    Dim Ret As Integer

        nfIconData.hwnd = MeHwnd
        nfIconData.uId = MeIcon
        nfIconData.uFlags = NIF_ICON Or NIF_MESSAGE Or NIF_TIP
        nfIconData.uCallBackMessage = WM_RBUTTONUP
        nfIconData.hIcon = MeIconHandle
        nfIconData.szTip = Tip & Chr$(0)
        nfIconData.dwState = 0
        nfIconData.cbSize = Len(nfIconData)
        Ret = Shell_NotifyIcon(NIM_ADD, nfIconData)
    End Sub

    Thanks in advance - Rhett

    Monday, May 02, 2011 10:36 AM

All replies

  • hi,

    a concise and complete example would be very helpful.

    Microsoft MVP Office Access
    Monday, May 02, 2011 11:15 AM
  • I have Separated the problem into an access form - This form works perfectly in Windows 7 Ulitmate 64Bit Access 2007 but not in Access 2010 64bit
    The Form Needs to Command Buttons on it One to add the TrayIcon and 2 to Remove the trayicon.
    Option Compare Database
    Option Explicit
       'Declare a user-defined variable to pass to the Shell_NotifyIcon
       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
       End Type
       'Declare the constants for the API function. These constants can be
       'found in the header file Shellapi.h.
       'The following constants are the messages sent to the
       'Shell_NotifyIcon function to add, modify, or delete an icon from the
       'taskbar status area.
       Private Const NIM_ADD = &H0
       Private Const NIM_MODIFY = &H1
       Private Const NIM_DELETE = &H2
       'The following constant is the message sent when a mouse event occurs
       'within the rectangular boundaries of the icon in the taskbar status
       Private Const WM_MOUSEMOVE = &H200
       'The following constants are the flags that indicate the valid
       'members of the NOTIFYICONDATA data type.
       Private Const NIF_MESSAGE = &H1
       Private Const NIF_ICON = &H2
       Private Const NIF_TIP = &H4
       'The following constants are used to determine the mouse input on the
       'the icon in the taskbar status area.
       'Left-click constants.
       Private Const WM_LBUTTONDBLCLK = &H203  'Double-click
       Private Const WM_LBUTTONDOWN = &H201   'Button down
       Private Const WM_LBUTTONUP = &H202    'Button up
       'Right-click constants.
       Private Const WM_RBUTTONDBLCLK = &H206  'Double-click
       Private Const WM_RBUTTONDOWN = &H204   'Button down
       Private Const WM_RBUTTONUP = &H205    'Button up
       'Declare the API function call.
       Private Declare PtrSafe Function Shell_NotifyIcon Lib "shell32" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, pnid As NOTIFYICONDATA) As Long
       'Dimension a variable as the user-defined data type.
       Dim nid As NOTIFYICONDATA
        Private Declare PtrSafe Function GetDC Lib "user32" (ByVal hwnd As Long) As LongLong
        Private Declare PtrSafe Function ReleaseDC Lib "user32" (ByVal hwnd As LongLong, ByVal hdc As LongLong) As LongLong
        Private Declare PtrSafe Function GetDeviceCaps Lib "gdi32" (ByVal hdc As LongLong, ByVal nIndex As LongLong) As LongLong
        Const HWND_DESKTOP As Long = 0
        Const LOGPIXELSX As LongLong = 88
        Const LOGPIXELSY As LongLong = 90
        Private Declare PtrSafe Function ExtractIcon Lib "shell32.dll" Alias "ExtractIconA" (ByVal hInst As Long, ByVal lpszExeFileName As String, ByVal nIconIndex As Long) As Long
       Private Sub Command1_Click()
         'Click this button to add an icon to the taskbar status area.
         'Set the individual values of the NOTIFYICONDATA data type.
         nid.hwnd = Me.hwnd
         nid.uId = vbNull
         nid.uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE
         nid.uCallBackMessage = WM_MOUSEMOVE
         nid.hIcon = ExtractIcond(0, CurrentProject.Path & "\InsAcc.ico", 0)
         nid.szTip = "Taskbar Status Area Sample Program" & vbNullChar
         nid.cbSize = Len(nid)
         'Call the Shell_NotifyIcon function to add the icon to the taskbar
         'status area.
         Shell_NotifyIcon NIM_ADD, nid
       End Sub
       Private Sub Command2_Click()
         'Click this button to delete the added icon from the taskbar
         'status area by calling the Shell_NotifyIcon function.
         Shell_NotifyIcon NIM_DELETE, nid
       End Sub
       Private Sub Form_Load()
         'Set the captions of the command button when the form loads.
         Command1.Caption = "Add an Icon"
         Command2.Caption = "Delete Icon"
       End Sub
       Private Sub Form_Close()
         'Delete the added icon from the taskbar status area when the
         'program ends.
         Shell_NotifyIcon NIM_DELETE, nid
       End Sub
    Function ExtractIcond(ByVal hInst As Long, ByVal lpszExeFileName As String, ByVal nIconIndex As Long) As Long
      ExtractIcond = ExtractIcon(hInst, lpszExeFileName, nIconIndex)
    End Function
    Function TwipsPerPixelX() As Single
    'Returns the width of a pixel, in twips.
     Dim lngDC As LongLong
     lngDC = GetDC(HWND_DESKTOP)
     TwipsPerPixelX = 1440& / GetDeviceCaps(lngDC, LOGPIXELSX)
     ReleaseDC HWND_DESKTOP, lngDC
    End Function
    Function TwipsPerPixelY() As Single
    'Returns the height of a pixel, in twips.
     Dim lngDC As LongLong
     lngDC = GetDC(HWND_DESKTOP)
     TwipsPerPixelY = 1440& / GetDeviceCaps(lngDC, LOGPIXELSY)
     ReleaseDC HWND_DESKTOP, lngDC
    End Function
    Monday, May 02, 2011 12:49 PM
  • As a point if you want to verify that it works in 2007 you would have to remove all instanctes of PtrSafe from the declarations and change all instances of the LongLong Data declarations... I have been trying to get this to work in access 2010 64 bit and that is the reason I added the PtrSafe and LongLong Data Types - I am new to 64 bit development... Hope you can help!!


    Monday, May 02, 2011 12:54 PM
  • Is there an area to upload the Accdb versions to in this forum - I am NEW Here!!

    Monday, May 02, 2011 12:56 PM
  • Hi Rhett,

    no, there is no such a possibility in this forum 'out of a box'. Just upload it to any file-share web site. I usually use Skydrive for such purposes. 

    Andrey V Artemyev | Saint-Petersburg, Russia
    Monday, May 02, 2011 2:33 PM
  • OK Thanks Andrey - Have uploaded the 2 TrayIconEg.accdb Files to Skydrive in a Public Folder - and the Icon the projects refer to - Put them in any folder and they should work if you have the respective Access 2007 or 2010.

    Simply the problem is I am trying to convert my Projects to Access 2010 64Bit from Access 2007.
    In office 2007 The TrayIcon Works - In Office 2010 64bit it doesn't - Why?

    Monday, May 02, 2011 3:14 PM
  • Does no one out there have any idea on this one - There must be a solution. How else can I can support from Microsoft to solve this problem?

    Tuesday, May 03, 2011 6:47 AM