Outlook VBA ThisOutlookSession 2宏可能吗？

Question

我有两个宏，我想在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的第二个实例，这样我就可以同时使用这两个实例。

谢谢!

Answer 1

您可以将项目传递给您的每个(重命名的) subs：

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

Answer 2

您可以将来自不同来源的代码组合到单个子中，也可以将其拆分成单独的函数，如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