Outlook VBA ThisOutlookSession 2 宏可能吗？

如何解决Outlook VBA ThisOutlookSession 2 宏可能吗？

我有 2 个要在 Outlook 中使用的宏。第一个宣布约会。

Private Sub Application_Reminder(ByVal Item As Object)
 
If Item.MessageClass <> "IPM.Appointment" Then
  Exit Sub
End If
 
Dim xlApp As Excel.Application
Dim timeOffset As Long
Dim strTimeOffset As String
Set xlApp = Excel.Application

timeOffset = (Item.Start - Now) * 1440

Select Case True
Case timeOffset < 60 'starts in under 1 hour
  strTimeOffset = timeOffset & " minutes,"

Case timeOffset <= 1440 'starts in under a day
  timeOffset = timeOffset / 60 
  strTimeOffset = timeOffset & " hours,"
  
Case timeOffset > 1440 'starts in more than a day
  timeOffset = timeOffset / 1440
  strTimeOffset = timeOffset & " days,on " & Format(Item.Start,"mmmm d")
End Select

 xlApp.Speech.Speak Item.Subject & "Starts in " & strTimeOffset & " at " & Format(Item.Start,"hh:mm am/pm"),True

Set xlApp = nothing

End Sub

第二个发送预定的电子邮件。

Private Sub Application_Reminder(ByVal Item As Object)
Dim objMsg As MailItem
Dim objApp As AppointmentItem
Dim Att As Attachment
Dim tmpFolder As String
Dim filePath As String
Set objMsg = Application.CreateItem(olMailItem)
MsgBox "Appointment Triggered"
'message is appointment
If Item.MessageClass <> "IPM.Appointment" Then Exit Sub
'The appointment is set as "Send Schedule Recurring Email" Category
If Item.Categories <> "Send Schedule Recurring Email" Then Exit Sub
'MsgBox Item.MessageClass
'MsgBox Item.Categories
'MsgBox Item.Location
'MsgBox Item.Subject
'MsgBox objMsg.Body
'MsgBox Environ("USERPROFILE")
'to get the path of the email attachment
tmpFolder = Environ("USERPROFILE")
'Add each attachment to email object to be sent
For Each Att In Item.Attachments
filePath = tmpFolder & "\" & Att.FileName
Att.SaveAsFile (filePath)
objMsg.Attachments.Add filePath
Kill filePath
Next Att
'send email object
objMsg.To = Item.Location
objMsg.Subject = Item.Subject
objMsg.Body = Item.Body
objMsg.Send
Set objMsg = nothing
End Sub

每个都单独工作，但我想同时使用两者。不幸的是，我不是一个程序员，所以我希望有人能解释一下，如果可以将它们结合起来或创建 ThisOutlookSession 的第二个实例，以便我可以同时使用两者。

谢谢！

解决方法

您可以将 Item 传递给您的每个（重命名的）订阅者：

Private Sub Application_Reminder(ByVal Item As Object)
    SaySomething Item
    SendAMail Item
End sub

Sub SaySomething(ByVal Item As Object)
   'do the speaking thing with `Item`
End sub

Sub SendAMail(ByVal Item As Object)
   'do the mail thing with `Item`
End sub

,

您可以将来自不同来源的代码合并到一个子程序中，也可以像 Tim 展示的那样将其拆分为单独的函数。我认为后者更好：

Private Sub Application_Reminder(ByVal Item As Object)
  AnnounceAppointments Item
  SendScheduledEmail Item
End Sub

Private Sub AnnounceAppointments(ByVal Item as Object)
  If Item.MessageClass <> "IPM.Appointment" Then
    Exit Sub
  End If
 
  Dim xlApp As Excel.Application
  Dim timeOffset As Long
  Dim strTimeOffset As String
  Set xlApp = New Excel.Application

  timeOffset = (Item.Start - Now) * 1440

  Select Case True
  Case timeOffset < 60 'starts in under 1 hour
    strTimeOffset = timeOffset & " minutes,"

  Case timeOffset <= 1440 'starts in under a day
    timeOffset = timeOffset / 60 
    strTimeOffset = timeOffset & " hours,"
  
  Case timeOffset > 1440 'starts in more than a day
    timeOffset = timeOffset / 1440
    strTimeOffset = timeOffset & " days,on " & Format(Item.Start,"mmmm d")
  End Select

  xlApp.Speech.Speak Item.Subject & "Starts in " & strTimeOffset & " at " & Format(Item.Start,"hh:mm am/pm"),True

  Set xlApp = Nothing
End Sub

Private Sub SendScheduledEmail(ByVal Item As Object)
  Dim objMsg As MailItem
  Dim objApp As AppointmentItem
  Dim Att As Attachment
  Dim tmpFolder As String
  Dim filePath As String
  Set objMsg = Application.CreateItem(olMailItem)
  MsgBox "Appointment Triggered"
  'message is appointment
  If Item.MessageClass <> "IPM.Appointment" Then Exit Sub
  'The appointment is set as "Send Schedule Recurring Email" Category

  If Item.Categories <> "Send Schedule Recurring Email" Then Exit Sub
  'MsgBox Item.MessageClass
  'MsgBox Item.Categories
  'MsgBox Item.Location
  'MsgBox Item.Subject
  'MsgBox objMsg.Body
  'MsgBox Environ("USERPROFILE")
  'to get the path of the email attachment
  tmpFolder = Environ("USERPROFILE")
  'Add each attachment to email object to be sent
  For Each Att In Item.Attachments
    filePath = tmpFolder & "\" & Att.FileName
    Att.SaveAsFile (filePath)
    objMsg.Attachments.Add filePath
    Kill filePath
  Next Att
  'send email object
  objMsg.To = Item.Location
  objMsg.Subject = Item.Subject
  objMsg.Body = Item.Body
  objMsg.Send
  Set objMsg = Nothing
End Sub