前些日子工作的需要,要在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里,所以没保存成附件发给大家,见谅了。