Advertisement
Guest User

Untitled

a guest
Jun 20th, 2019
417
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 5.20 KB | None | 0 0
  1. Module RemoveNotification
  2. ' Code sample by Outlook MVP "Neo"
  3. ' Removes the New Mail icon from the Windows system tray,
  4. ' and resets Outlook's new mail notification engine.
  5. ' Tested against Outlook 2000 (IMO) and Outlook 2002 (POP Account)
  6. ' Send questions and comments to neo@mvps.org
  7. ' WARNING: Due to the use of AddressOf, code must
  8. ' go into a module and not ThisOutlookSession or
  9. ' a class module
  10. ' Entry Point is RemoveNewMailIcon.
  11.  
  12. Public Const WUM_RESETNOTIFICATION As Long = &H407
  13.  
  14. 'Required Public constants, types & declares
  15. 'for the Shell_Notify API method
  16. Public Const NIM_ADD As Long = &H0
  17. Public Const NIM_MODIFY As Long = &H1
  18. Public Const NIM_DELETE As Long = &H2
  19.  
  20. Public Const NIF_ICON As Long = &H2 'adding an ICON
  21. Public Const NIF_TIP As Long = &H4 'adding a TIP
  22. Public Const NIF_MESSAGE As Long = &H1 'want return messages
  23.  
  24. ' Structure needed for Shell_Notify API
  25. Structure NOTIFYICONDATA
  26. Dim cbSize As Long
  27. Dim hwnd As Long
  28. Dim uID As Long
  29. Dim uFlags As Long
  30. Dim uCallbackMessage As Long
  31. Dim hIcon As Long
  32. Dim szTip As String * 64
  33. End Structure
  34.  
  35. Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
  36. (ByVal hwnd As Long, ByVal wMsg As Long,
  37. ByVal wParam As Integer, ByVal lParam As Any) As Long
  38.  
  39. Declare Function GetClassName Lib "user32" _
  40. Alias "GetClassNameA" _
  41. (ByVal hwnd As Long,
  42. ByVal lpClassName As String,
  43. ByVal nMaxCount As Long) As Long
  44.  
  45. Declare Function GetWindowTextLength Lib "user32" _
  46. Alias "GetWindowTextLengthA" _
  47. (ByVal hwnd As Long) As Long
  48.  
  49. Declare Function GetWindowText Lib "user32" _
  50. Alias "GetWindowTextA" _
  51. (ByVal hwnd As Long,
  52. ByVal lpString As String,
  53. ByVal cch As Long) As Long
  54.  
  55. Declare Function EnumWindows Lib "user32" _
  56. (ByVal lpEnumFunc As Long,
  57. ByVal lParam As Long) As Long
  58.  
  59. Declare Function Shell_NotifyIcon Lib "shell32.dll" _
  60. Alias "Shell_NotifyIconA" _
  61. (ByVal dwMessage As Long,
  62. lpData As NOTIFYICONDATA) As Long
  63.  
  64. Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
  65. (ByVal lpClassName As String,
  66. ByVal lpWindowName As String) As Long
  67.  
  68. ' This is the entry point that makes it happen
  69. Sub RemoveNewMailIcon()
  70. EnumWindows AddressOf EnumWindowProc, 0
  71. End Sub
  72.  
  73. Public Function EnumWindowProc(ByVal hwnd As Long,
  74. ByVal lParam As Long) As Long
  75.  
  76. 'Do stuff here with hwnd
  77. Dim sClass As String
  78. Dim sIDType As String
  79. Dim sTitle As String
  80. Dim hResult As Long
  81.  
  82. sTitle = GetWindowIdentification(hwnd, sIDType, sClass)
  83. If sTitle = "rctrl_renwnd32" Then
  84. hResult = KillNewMailIcon(hwnd)
  85. End If
  86.  
  87. If hResult Then
  88. EnumWindowProc = False
  89. ' Reset the new mail notification engine
  90. Call SendMessage(hwnd, WUM_RESETNOTIFICATION, 0&, 0&)
  91. Else
  92. EnumWindowProc = True
  93. End If
  94. End Function
  95.  
  96. Private Function GetWindowIdentification(ByVal hwnd As Long,
  97. sIDType As String,
  98. sClass As String) As String
  99.  
  100. Dim nSize As Long
  101. Dim sTitle As String
  102.  
  103. 'get the size of the string required
  104. 'to hold the window title
  105. nSize = GetWindowTextLength(hwnd)
  106. 'if the return is 0, there is no title
  107. If nSize > 0 Then
  108. sTitle = Space$(nSize + 1)
  109. Call GetWindowText(hwnd, sTitle, nSize + 1)
  110. sIDType = "title"
  111. sClass = Space$(64)
  112. Call GetClassName(hwnd, sClass, 64)
  113. Else
  114. 'no title, so get the class name instead
  115. sTitle = Space$(64)
  116. Call GetClassName(hwnd, sTitle, 64)
  117. sClass = sTitle
  118. sIDType = "class"
  119. End If
  120.  
  121. GetWindowIdentification = TrimNull(sTitle)
  122. End Function
  123.  
  124. Private Function TrimNull(startstr As String) As String
  125. Dim pos As Integer
  126. pos = InStr(startstr, Chr$(0))
  127. If pos Then
  128. TrimNull = Left(startstr, pos - 1)
  129. Exit Function
  130. End If
  131.  
  132. 'if this far, there was
  133. 'no Chr$(0), so return the string
  134. TrimNull = startstr
  135. End Function
  136.  
  137. Private Function KillNewMailIcon(ByVal hwnd As Long) As Boolean
  138. Dim pShell_Notify As NOTIFYICONDATA
  139. Dim hResult As Long
  140.  
  141. 'setup the Shell_Notify structure
  142. pShell_Notify.cbSize = Len(pShell_Notify)
  143. pShell_Notify.hwnd = hwnd
  144. pShell_Notify.uID = 0
  145.  
  146. ' Remove it from the system tray and catch result
  147. hResult = Shell_NotifyIcon(NIM_DELETE, pShell_Notify)
  148. If (hResult) Then
  149. KillNewMailIcon = True
  150. Else
  151. KillNewMailIcon = False
  152. End If
  153. End Function
  154. End Module
  155.  
  156. Severity Code Description Line
  157. Error BC30205 End of statement expected. 35
  158. Error BC30800 Method arguments must be enclosed in parentheses. 73
  159. Error BC30828 'As Any' is not supported in 'Declare' statements. 40
  160. Error BC30581 'AddressOf' expression cannot be converted to 'Long' because 'Long' is not a delegate type. 73
  161. Error BC30277 Type character '$' does not match declared data type 'Char'. 129
  162. Warning BC42104 Variable 'sIDType' is used before it has been assigned a value. A null reference exception could result at runtime. 85
  163. Warning BC42104 Variable 'sClass' is used before it has been assigned a value. A null reference exception could result at runtime. 85
  164. Warning BC42109 Variable 'pShell_Notify' is used before it has been assigned a value. A null reference exception could result at runtime. Make sure the structure or all the reference members are initialized before use 145
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement