在OUTLOOK里实现记时器

阅读更多

    前些日子工作的需要，要在outlook里写VBA实现定时检查邮件然后报警这样的功能。搞了好段时间才搞定，其中遇到的一个问题就是outlook里不支持VBA中ontime等函数的使用，用等待等函数又使得outlook一直被VBA宏占用，不能正常收发邮件了。

    最后我还是通过借助Windows API 函数SetTimer和KillTimer实现了我要完成的功能。

    代码如下：

Private Declare Function SetTimer Lib "user32.dll" (ByVal hwnd As Long, ByVal nIDEvent As Long, _
                        ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Private Declare Function KillTimer Lib "user32.dll" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long
Const INTERVAL = 300000
Public lTimerID As Long

Sub StartTimer(lDuration As Long)
    On Error GoTo SubEnd
    If lTimerID = 0 Then
        lTimerID = SetTimer(0&, 0&, lDuration, AddressOf Alert) 'Alert就是我要定时执行的函数的名，可以用你需要定时执行的函数替换
    Else
        Call StopTimer
        lTimerID = SetTimer(0&, 0&, lDuration, AddressOf Alert)
    End If
SubEnd:
End Sub

Sub StopTimer()
    KillTimer 0&, lTimerID
End Sub

Private Sub Application_Quit()
    Call StopTimer
End Sub

Private Sub Application_Startup() '当outlook打开时（首先宏安全性要允许执行宏）触发此事件
    Call StartTimer(INTERVAL) 'INTERVAL的单位是毫秒，我设置的是每隔5分钟。此函数的功能是相隔INTERVAL毫秒函数自动再次被调用
End Sub

Windows API 函数SetTimer和KillTimer说明如下：

SetTimer：创建或设置一个定时器。

    函数的原型

 

　　UINT_PTR SetTimer(

 

　　HWND hWnd, //窗口句柄

 

　　UINT_PTR nIDEvent, // 定时器ID，多个定时器时，可以通过该ID判断是哪个定时器

 

　　UINT nElapse, // 时间间隔,单位为毫秒

 

　　TIMERPROC lpTimerFunc //回调函数

 

　　);

KillTimer：移除定时器函数的声明:移除先前用SetTimer设置的定时器。在定时器使用完毕后移除定时器时使用。

 

　　函数原型：

 

　　BOOL KillTimer(

 

　　HWND hwnd; //与定时器相关联的窗口句柄

 

　　UINT nIDEvent //定时器标识符

 

　　):

 

　　参数：

 

　　hwnd：与定时器相关联的窗口句柄

 

　　nIDEvent： 传递给SetTimer的定时器ID值。

 

　　说明：

 

　　销毁以前调用SetTimer创建的用nIDEvent标识的定时器事件。不能将此定时器有关的未处理的WM_TIMER消息都从消息队列中清除。

 

　　返回值

 

　　BOOL 如果函数成功,返回一个非0值,

 

　　如果失败,返回值为0

 

　　注意: 该函数并不移除WM_TIMER 先前发送到消息列队中的消息

 

由于outlook的VBA是写的ThisOutlookSession里，所以没保存成附件发给大家，见谅了。