首页 > 解决方案 > 首次使用 Outlook VBA 后,工作事件代码不再触发

问题描述

我创建了一个程序,可以在弹出某个提醒时(每个月初)自动发送电子邮件。我在两周前编写代码时对代码进行了几次测试,并且成功了。

现在提醒确实第一次“真实地”弹出,它不起作用。

我在 Application_Reminder 子的唯一行中插入了一个断点。代码永远不会在断点处停止,这对我来说表明事件没有被触发。

我试过谷歌搜索。为什么事件没有被触发,我怎样才能触发它?

Private Sub Application_Reminder(ByVal Item As Object)
  SendAutoEmail Item
End Sub

Private Sub SendAutoEmail(Item As Object)
  Dim oTask As Outlook.TaskItem
  Dim oMail As Outlook.MailItem
  Dim oFld As Outlook.MAPIFolder
  Dim ReminderSubject As String
  Dim EmailSubject As String
  Dim SendTo As String
  Dim Message As String
  Dim Signature As String
  
  'Task item
  ReminderSubject = "Project reminder"

  'Email
  SendTo = "Project team"
  EmailSubject = "Project progress"
  

  If TypeOf Item Is Outlook.TaskItem Then
    Set oTask = Item
    If LCase$(oTask.Subject) = LCase$(ReminderSubject) Then
      Message = "Test message"

      oTask.ReminderTime = DateAdd("m", 1, oTask.ReminderTime)
      oTask.Save

      Set oMail = Application.CreateItem(olMailItem)
      oMail.Display
      Signature = oMail.Body
      oMail.Subject = EmailSubject
      oMail.Body = Message & vbCrLf & Signature
      oMail.Recipients.Add SendTo
      oMail.Recipients.ResolveAll
      oMail.Display
    End If
  End If
End Sub

标签: vbaoutlook

解决方案


尝试使用提醒来触发事件可能会出现问题,如果 PC 长时间锁定,VBA 似乎可以停止触发。此外,如果编辑代码或检测到错误,则 Outlook 将停止所有 VBA 工作,您需要关闭并重新打开 Outlook 以重新初始化 VBA

ThisOutlookSession您可以在模块中尝试以下替代代码:

Private WithEvents MyReminders As Outlook.Reminders

Private Sub Application_Startup()
    On Error Resume Next
    Set MyReminders = Outlook.Application.Reminders
End Sub

Private Sub MyReminders_ReminderFire(ByVal ReminderObject As Reminder)
    On Error Resume Next
    Call SendAutoEmail(ReminderObject.Item)
End Sub

推荐阅读