使用 VBScript 在 Windows 任务栏中显示新邮件图标

Question

我很难将 Outlook 配置为仅在我需要时才显示新邮件消息图标。我设置了几个不想显示的规则/过滤器，但它们总是这样做。我尝试了一切，但这不是我的问题。我发现一个好的解决方案是创建一个 vbs 脚本，该脚本调用我用来通知我的 bash 脚本。我在我的包罗万象的规则中调用此代码，并让所有其他规则提前退出。它工作得很好。不过，我真正想要的是在任务栏中显示新邮件图标（信封）。我真的对vb，vba，vbs一无所知。但是，如果有人可以在文件中发送我需要的代码，我很乐意试一试。 谢谢！

Answer 1

据我所知，没有直接的方法可以使用 VBA 显示 新邮件图标。但是，您可以按需添加一个不同的托盘图标。我确信有一种方法可以通过使用 LoadIcon 或类似的 Win32 函数来显示类似外观的图标，但我无法弄清楚如何。

请注意，这只适用于 32 位 Office（我无法让它在 64 位中工作；所以你在这方面不走运 - 即使在 Microsoft forums 中，那个问题未解决。再说一次，我认为 Stack Overflow 比 Microsoft 论坛更高）。

1. 进入Tools->Macros->Visual Basic Editor，点击View->Project explorer。
2. 在左侧项目窗口中，右键单击“Project1”并选择“插入”->“模块”。
3. 双击刚刚创建的新模块，

并粘贴以下代码：

'Some code borrowed from:
'http://support.microsoft.com/kb/176085

Public 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

Public Const NIM_ADD = &H0
Public Const NIM_MODIFY = &H1
Public Const NIM_DELETE = &H2
Public Const NIF_MESSAGE = &H1
Public Const NIF_ICON = &H2
Public Const NIF_TIP = &H4

Public Const IDI_APPLICATION = 32512&
Public Const IDI_ASTERISK = 32516&
Public Const IDI_EXCLAMATION = 32515&
Public Const IDI_HAND = 32513&
Public Const IDI_ERROR = IDI_HAND
Public Const IDI_INFORMATION = IDI_ASTERISK
Public Const IDI_QUESTION = 32514&
Public Const IDI_WARNING = IDI_EXCLAMATION
Public Const IDI_WINLOGO = 32517&

Public Const WM_MOUSEMOVE = &H200
Public Const WM_LBUTTONDOWN = &H201
Public Const WM_LBUTTONUP = &H202
Public Const WM_LBUTTONDBLCLK = &H203
Public Const WM_RBUTTONDOWN = &H204
Public Const WM_RBUTTONUP = &H205
Public Const WM_RBUTTONDBLCLK = &H206

Public Declare Function SetForegroundWindow Lib "user32" _
    (ByVal hwnd As Long) As Long
Public Declare Function Shell_NotifyIcon Lib "shell32" _
Alias "Shell_NotifyIconA" _
    (ByVal dwMessage As Long, pnid As NOTIFYICONDATA) As Boolean

Public Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" _
    (ByVal hWndParent As Long, ByVal hwndChildAfter As Long, _
    ByVal lpszClass As String, ByVal lpszWindow As String) As Long

Public Declare Function LoadIcon Lib "user32" Alias "LoadIconA" (ByVal hInstance As Long, ByVal lpIconName As Long) As Long

Public nid As NOTIFYICONDATA

Public Sub ShowNotifyIcon()
    With nid
        .cbSize = Len(nid)
        .hwnd = 0
        'If you un-comment this line below the icon won't disappear when you mouse over it. You will need to use the HideNotifyIcon() function to make it disappear
        '.hwnd = FindWindowEx(0&, 0&, "mspim_wnd32", "Microsoft Outlook")
        .uId = vbNull
        .uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE
        .uCallBackMessage = WM_MOUSEMOVE

        .hIcon = LoadIcon(0&, IDI_APPLICATION)
        .szTip = "A message has arrived" & vbNullChar
       End With
       Shell_NotifyIcon NIM_ADD, nid
End Sub

Public Sub HideNotifyIcon()
    Shell_NotifyIcon NIM_DELETE, nid
End Sub

现在，为了能够在 Outlook 规则中使用这些，您需要双击 ThisOutlookSession，然后粘贴以下代码：

Public Sub ShowNewMailIcon(Item As Outlook.MailItem)
        Call ShowNotifyIcon
End Sub

Public Sub HideNewMailIcon(Item As Outlook.MailItem)
        Call HideNotifyIcon
End Sub

现在您可以保存并关闭 Visual Basic 窗口。

要在规则中使用这些功能，您可以创建一个新规则：工具->规则和警报->新规则，在前 2 个屏幕上选择您的条件，然后在“选择操作”屏幕上，选择“运行脚本”。当您将其添加到规则中并单击带下划线的“运行脚本”时，您应该会看到 2 个函数“ShowIconInTray”和“HideIconInTray”。

当您在规则中使用 ShowIconInTray 时，该图标应该会在规则运行时出现，而当您将鼠标悬停在它上面时，它应该会消失（我在为图标提供其他功能时遇到了挑战，因为没有窗口句柄将其连接到可以接收和处理图标上的鼠标事件）。

您可能需要检查 Outlook 的安全性（工具->宏->安全性）。我认为 Outlook 2007 预配置了高安全性。要使宏始终运行，您可以选择“不对宏进行安全检查”或“宏警告”。签署 VBA 很容易，但超出了此答案的范围。

这不是我最喜欢的代码，而且有点骇人听闻；但是 Shell_NotifyIcon 并不是真正设计用于 VBA，而且您不能在 VBScript 中使用 Win32 函数。最佳替代答案可能包括 VSTO 加载项，但您不能真正将加载项“粘贴”到答案中——而且它需要 Visual Studio。

Answer 2

使用以下内容创建 c:\scheduletools\mailcheck.vbs

Set otl = createobject("outlook.application")
Set session = otl.getnamespace("mapi")
session.logon ''use parameters if required - see below
''session.Logon "myUsername", "password", False, False

Set inbox = session.getdefaultfolder(6) '' 6 is for inbox
c = 0
For Each m In inbox.items
  If m.unread Then c = c + 1
Next
session.logoff
s = "s"
If c = 1 Then s = ""
Msgbox "You have " & c & " unread message" & s

自动运行它的一种方法是通过任务调度程序

(start -> run -> (type)tasks -> enter)

您可以指定多个计划。 VB 脚本文件可以直接从 Windows 任务计划运行。在任务计划程序中，选择添加新的计划任务。按照提示，浏览以选择您的 .vbs 文件。命名您的任务并选择您的计划以每天运行该任务并选择一天中的运行时间。它的工作原理与您要安排 .Bat 文件一样。

在命令中使用绝对文件路径。

或创建一个 .bat 文件调用您的 vbs 文件

cscript //nologo c:\schedulttools\mailcheck.vbs

请注意，如果您有将邮件移动到不同文件夹的交换级别规则，那么您需要在所有这些文件夹中查找新邮件。

希望有帮助

Answer 3

首先添加对 Microsoft shell 控件和通知的引用，然后使用以下代码将模块添加到您的 Outlook vba 项目。它提供了显示和隐藏托盘图标的功能（当前设置为 c:\temp\msn.ico），您需要修改它以显示合适的邮件图标。

' Add reference to Microsoft shell controls and notification

Public Declare Function Shell_NotifyIconA Lib "shell32.dll" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Long
Public hWnd As Long
Private Declare Function GetActiveWindow Lib "user32" () As Long


Public Type NOTIFYICONDATA
cbSize As Long ' Size of the NotifyIconData structure
hWnd As Long ' Window handle of the window processing the icon events
uID As Long ' Icon ID (to allow multiple icons per application)
uFlags As Long ' NIF Flags
uCallbackMessage As Long ' The message received for the system tray icon if NIF_MESSAGE specified. Can be in the range 0x0400 through 0x7FFF (1024 to 32767)
hIcon As Long ' The memory location of our icon if NIF_ICON is specifed
szTip As String * 64 ' Tooltip if NIF_TIP is specified (64 characters max)
End Type

' Shell_NotifyIconA() messages
Public Const NIM_ADD = &H0 ' Add icon to the System Tray
Public Const NIM_MODIFY = &H1 ' Modify System Tray icon
Public Const NIM_DELETE = &H2 ' Delete icon from System Tray

' NotifyIconData Flags
Public Const NIF_MESSAGE = &H1 ' uCallbackMessage in NOTIFYICONDATA is valid
Public Const NIF_ICON = &H2 ' hIcon in NOTIFYICONDATA is valid
Public Const NIF_TIP = &H4 'szTip in NOTIFYICONDATA is valid

Private Sub AddTrayIcon()
Dim nid As NOTIFYICONDATA

' nid.cdSize is always Len(nid)
nid.cbSize = Len(nid)
' Parent window - this is the window that will process the icon events
nid.hWnd = GetActiveWindow()
' Icon identifier
nid.uID = 0
' We want to receive messages, show the icon and have a tooltip
nid.uFlags = NIF_MESSAGE Or NIF_ICON Or NIF_TIP
' The message we will receive on an icon event
nid.uCallbackMessage = 1024
' The icon to display
Dim myPicture As IPictureDisp
strPath = "c:\temp\msn.ico"
Set myPicture = LoadPicture(strPath)
nid.hIcon = myPicture
' Our tooltip
nid.szTip = "Always terminate the tooltip with vbNullChar" & vbNullChar

' Add the icon to the System Tray
Shell_NotifyIconA NIM_ADD, nid


End Sub



Private Sub RemoveTrayIcon()
Dim nid As NOTIFYICONDATA

nid.hWnd = GetActiveWindow()
nid.cbSize = Len(nid)
nid.uID = 0 ' The icon identifier we set earlier

' Delete the icon
Shell_NotifyIconA NIM_DELETE, nid

End Sub

请参阅here 和here 获取原始代码。

Answer 4

我遇到了同样的问题，但从 Windows 7 开始，我不再寻找托盘图标，而是查看 Outlook 任务按钮。

我编写了以下脚本来通知窗口 Outlook 任务栏按钮将开始闪烁，直到 Outlook 窗口变为活动状态。脚本必须从规则中执行。

Option Explicit

Private Type FLASHWINFO
  cbSize As Long
  hWnd As Long
  dwFlags As Long
  uCount As Long
  dwTimeout As Long
End Type

Private Declare Sub ZeroMemory Lib "kernel32.dll" Alias "RtlZeroMemory" (ByRef pData As Any, ByVal nSize As Long)
Private Declare Function FlashWindowEx Lib "user32.dll" (ByRef pFlashWInfo As FLASHWINFO) As Boolean
Private Declare Function FindWindowEx Lib "user32.dll" Alias "FindWindowExA" (ByVal hWndParent As Long, ByVal hWndChildAfter As Long, ByVal lpszClass As String, ByVal lpszWindow As String) As Long

Private Const FLASHW_ALL As Long = &H3&
Private Const FLASHW_CAPTION As Long = &H1&
Private Const FLASHW_STOP As Long = &H0&
Private Const FLASHW_TIMER As Long = &H4&
Private Const FLASHW_TIMERNOFG As Long = &HC&
Private Const FLASHW_TRAY As Long = &H2&

Public Sub OnNotification(Item As Outlook.MailItem)
  Dim fwi As FLASHWINFO

  Call ZeroMemory(fwi, Len(fwi))
  fwi.cbSize = Len(fwi)
  fwi.hWnd = GetHWND
  fwi.dwFlags = FLASHW_TRAY Or FLASHW_TIMERNOFG
  fwi.uCount = -1
  fwi.dwTimeout = 0
  Call FlashWindowEx(fwi)
End Sub

Private Function GetHWND() As Long
  GetHWND = FindWindowEx(0, 0, vbNullString, Application.ActiveWindow.Caption)
End Function

这是一个适合我的问题的解决方案。