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

时间:2012-02-21 13:18:45

标签: vba outlook outlook-vba

我最难配置Outlook以便在我想要的时候显示新的邮件消息图标。我有几个规则/过滤器设置,我不想显示,但他们总是这样做。我尝试了一切,但这不是我的问题。我发现一个好的解决方案是创建一个vbs脚本,调用我用来通知我的bash脚本。我在我的catch-all规则中调用此代码,并让所有其他规则提前退出。它工作得很好。但是,我真正喜欢的是在任务栏中显示新的邮件图标(信封)。我真的不知道vb,vba,vbs。但如果有人可以在文件中发送我需要的代码,我很乐意尝试一下。 谢谢!

4 个答案:

答案 0 :(得分:6)

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

请注意,这仅适用于32位Office(我无法使其在64位中运行;因此您在这方面运气不佳 - 即使在Microsoft forums中,那个问题没有得到解决。再说一遍,我认为Stack Overflow比微软论坛更为重要。)

  1. 转到“工具” - >“宏” - >“Visual Basic编辑器”,然后单击“查看” - >“项目浏览器”。
  2. 在左侧的Project窗口中,右键单击“Project1”并选择Insert-> Module。
  3. 双击刚刚创建的新模块
  4. 并粘贴以下代码:

    '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”。

    enter image description here

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

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

    这不是我最喜欢的代码,而且有些骇人听闻;但是Shell_NotifyIcon并不是真的设计用于VBA,而且你不能在VBScript中使用Win32函数。最好的替代答案可能包括VSTO加载项,但你不能真正“粘贴”一个加载项到答案 - 加上它需要Visual Studio。

答案 1 :(得分:3)

使用以下内容创建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文件的方式相同。

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

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

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

请注意,如果您有将交换级别规则移动到不同文件夹的交换级别规则,则需要查找所有这些文件夹以获取新邮件。

希望这个帮助

答案 2 :(得分: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

有关原始代码,请参阅herehere

答案 3 :(得分:1)

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

我编写了以下脚本来通知windows,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

这是解决我问题的合适方法。