我是否可以创建Outlook规则以从邮件正文创建日历警报

我想要做的是从邮件主题行创建一个日历事件，如下所示。

如果我收到任何带有邮件正文的邮件作为截止日期：01/01/2015，它应该在日历中创建一个事件，并在出现该日期和时间时提醒我。

这可能是规则还是宏？任何帮助将非常感激。

宏我到现在为止尝试过：

Sub CreateAppt(Item As Outlook.MailItem)
Dim newOrder As Outlook.MailItem
Dim thebody As String
Dim date1 As Date
Dim strdate As String
Dim time As String
Dim address As String
Dim TI As Outlook.AppointmentItem

thebody = Item.Body

strdate = Mid(thebody, InStr(1, thebody, "date1: ") + 7, _
InStr(InStr(1, thebody, "date1: "), thebody, vbCrLf) - _
InStr(1, thebody, "date1: ") - 7)

Date = DateSerial(Split(strdate, "/")(2), _
Split(strdate, "/")(1), _
Split(strdate, "/")(0))

time = Mid(thebody, InStr(1, thebody, "time: ") + 5, _
InStr(InStr(1, thebody, "time: "), thebody, vbCrLf) - _
InStr(1, thebody, "time: ") - 5)

address = Mid(thebody, InStr(1, thebody, "address: ") + 7, _
InStr(InStr(1, thebody, "address: "), thebody, vbCrLf) - _
InStr(1, thebody, "address: ") - 7)

Set TI = Application.CreateItem(olAppointmentItem)
With TI
 .Subject = Item.Subject
 .Location = address
 .Start = date1 & time
 .Duration = 0
 .Body = Item.Body
 .ReminderMinutesBeforeStart = 15
 .Save
 '.Display
End With
End Sub

我发现了这个线索 MSDN 博客。多年来我没有做任何编码，但也许这会帮助你。

作者：Felix Boehme 2013年6月19日下午4:46

Option Explicit

Dim item As Object

Sub NewMeetingReadingPane()

   Set item = Application.ActiveExplorer.Selection(1)

   NewMeetingRequestFromEmail

End Sub

Sub NewMeetingOpenEmail()

   Set item = Application.ActiveInspector.CurrentItem

   NewMeetingRequestFromEmail

End Sub

' Create a New Meeting request from an email

' Written by Michael S. Scherotter (mischero@microsoft.com)

' 1. If the current item is an email, create a new appointment item

' 2. Copy the categories, body, and subject

' 3. Copy the attachments

' 4. Add the sender as a meeting participant

' 5. Add each email recipient as a meeting participant

' 6.    Each To: participant will be required

' 7.    Each CC: or BCC: participant will be optional

Sub NewMeetingRequestFromEmail()

   Dim app As New Outlook.Application

   'Dim item As Object

   'Set item = app.ActiveInspector.CurrentItem

   'Set item = Application.ActiveExplorer.Selection(1)

   If item.Class <> olMail Then Exit Sub

   Dim email As MailItem

   Set email = item

   Dim meetingRequest As AppointmentItem

   Set meetingRequest = app.CreateItem(olAppointmentItem)

   meetingRequest.Categories = email.Categories

   'meetingRequest.Body = email.Body

   meetingRequest.Subject = email.Subject

   meetingRequest.Attachments.Add item, olEmbeddeditem

'    Dim attachment As attachment

'    For Each attachment In email.Attachments

'        CopyAttachment attachment, meetingRequest.Attachments

'    Next attachment

   Dim recipient As recipient

   Set recipient = meetingRequest.Recipients.Add(email.SenderEmailAddress)

   recipient.Resolve

   For Each recipient In email.Recipients

       RecipientToParticipant recipient, meetingRequest.Recipients

   Next recipient

   meetingRequest.MeetingStatus = olMeeting

   Dim inspector As inspector

   Set inspector = meetingRequest.GetInspector

   'inspector.CommandBars.FindControl

   inspector.Display

End Sub

Private Sub RecipientToParticipant(recipient As recipient, participants As Recipients)

   Dim participant As recipient

   If LCase(recipient.Address) <> LCase(Session.CurrentUser.Address) Then

       Set participant = participants.Add(recipient.Address)

       Select Case recipient.Type

       Case olBCC:

           participant.Type = olOptional

       Case olCC:

           participant.Type = olOptional

       Case olOriginator:

           participant.Type = olRequired

       Case olTo:

           participant.Type = olRequired

       End Select

       participant.Resolve

   End If

End Sub

Private Sub CopyAttachment(source As attachment, destination As Attachments)

   On Error GoTo HandleError

   Dim filename As String

   filename = Environ("temp") & "\" & source.filename

   source.SaveAsFile (filename)

   destination.Add (filename)

   Exit Sub

HandleError:

   Debug.Print Err.Description

End Sub