Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations gkittelson on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Outlook 2000 Code Clip: How do I use it?

Status
Not open for further replies.

BradB

MIS
Jun 21, 2001
237
US
I got the following code from
The instructions are as follows:
"Outlook MVP Neo has come up with an Outlook 2000/2002 VBA solution that uses Windows API calls to get rid of the icon. The icon is governed by an internal trigger in Outlook. Outlook won't send another message to the system tray to post another new mail icon until some user action clears its internal trigger. For example, you might start Outlook, check mail, clear the icon with the code, and then minimize Outlook. You shouldn't see the envelopeicon again until you restart or perform some action that resets the internal trigger."

I just don't know how to envoke it. The instructions aren't very clear? I've posted the code below into a module and called it MarkAsRead. I don't know what the next step is. How do I envoke it?

--Brad B

Code:
Option Explicit



'Required Public constants, types & declares

'for the Shell_Notify API method

Public Const NIM_ADD As Long = &H0

Public Const NIM_MODIFY As Long = &H1

Public Const NIM_DELETE As Long = &H2

Public Const NIF_ICON As Long = &H2 'adding an ICON

Public Const NIF_TIP As Long = &H4 'adding a TIP

Public Const NIF_MESSAGE As Long = &H1 'want return messages



' Structure needed for Shell_Notify API

Type NOTIFYICONDATA

cbSize As Long

hwnd As Long

uID As Long

uFlags As Long

uCallbackMessage As Long

hIcon As Long

szTip As String * 64

End Type



Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long



Declare Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal hwnd As Long) As Long



Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long



Declare Function EnumWindows Lib "user32" (ByVal lpEnumFunc As Long, ByVal lParam 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 FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long

' This is the entry point that makes it happen

Sub RemoveNewMailIcon()

EnumWindows AddressOf EnumWindowProc, 0

End Sub



Public Function EnumWindowProc(ByVal hwnd As Long, ByVal lParam As Long) As Long


'Do stuff here with hwnd

Dim sClass As String

Dim sIDType As String

Dim sTitle As String

Dim hResult As Long


sTitle = GetWindowIdentification(hwnd, sIDType, sClass)


If sTitle = "rctrl_renwnd32" Then

hResult = KillNewMailIcon(hwnd)

End If


'To continue enumeration, return True

'To stop enumeration return False (0).

'When 1 is returned, enumeration continues

'until there are no more windows left.

If hResult Then

EnumWindowProc = False

Else

EnumWindowProc = True

End If

End Function



Private Function GetWindowIdentification(ByVal hwnd As Long, sIDType As String, sClass As String) As String

Dim nSize As Long

Dim sTitle As String



'get the size of the string required

'to hold the window title

nSize = GetWindowTextLength(hwnd)


'if the return is 0, there is no title

If nSize > 0 Then

sTitle = Space$(nSize + 1)

Call GetWindowText(hwnd, sTitle, nSize + 1)

sIDType = "title"

sClass = Space$(64)

Call GetClassName(hwnd, sClass, 64)

Else

'no title, so get the class name instead

sTitle = Space$(64)

Call GetClassName(hwnd, sTitle, 64)

sClass = sTitle

sIDType = "class"

End If


GetWindowIdentification = TrimNull(sTitle)

End Function



Private Function TrimNull(startstr As String) As String

Dim pos As Integer

pos = InStr(startstr, Chr$(0))


If pos Then

TrimNull = Left$(startstr, pos - 1)

Exit Function

End If


'if this far, there was

'no Chr$(0), so return the string

TrimNull = startstr

End Function



Private Function KillNewMailIcon(ByVal hwnd As Long) As Boolean

Dim pShell_Notify As NOTIFYICONDATA

Dim hResult As Long



'setup the Shell_Notify structure

pShell_Notify.cbSize = Len(pShell_Notify)

pShell_Notify.hwnd = hwnd

pShell_Notify.uID = 0


' Remove it from the system tray and catch result

hResult = Shell_NotifyIcon(NIM_DELETE, pShell_Notify)


If (hResult) Then

KillNewMailIcon = True

Else

KillNewMailIcon = False

End If

End Function
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top