I am new to VB and trying to create a macro that will parse the body of an e-mail for a scheduled start time and create an appointment with the start and end times from the e-mail body.
So far I have managed to create a macro that will create an appointment and pop up a reminder, but I cannot get the time of the appointment set based on the time variables in the e-mail body.
Any assistance or insight anyone can offer will be greatly appreciated.
The macro I have is below and below that is a snippet from the body of the e-mails we receive.
Macro:
Sub NewMeetingRequestFromEmail2(item As Outlook.MailItem)
Dim email As MailItem
Set email = item
Dim meetingRequest As AppointmentItem
Dim stime As String
Dim etime As String
Set meetingRequest = Application.CreateItem(olAppointmentItem)
meetingRequest.MeetingStatus = olMeeting
meetingRequest.Body = email.Body
meetingRequest.Subject = email.Subject
stime = ParseTextLinePair(email.Body, "Scheduled Start:")
etime = ParseTextLinePair(email.Body, "Scheduled Finish:")
meetingRequest.Start = makedate(stime)
meetingRequest.End = makedate(etime)
meetingRequest.ReminderSet = True
meetingRequest.ReminderMinutesBeforeStart = 300
meetingRequest.Save
End Sub
Function ParseTextLinePair _
(strSource As String, strLabel As String)
Dim intLocLabel As Integer
Dim intLocCRLF As Integer
Dim intLenLabel As Integer
Dim stime As String
intLocLabel = InStr(strSource, strLabel)
intLenLabel = Len(strLabel)
If intLocLabel > 0 Then
intLocCRLF = InStr(intLocLabel, strSource, vbCrLf)
If intLocCRLF > 0 Then
intLocLabel = intLocLabel + intLenLabel
stime = Mid(strSource, _
intLocLabel, _
intLocCRLF - intLocLabel)
Else
intLocLabel = _
Mid(strSource, intLocLabel + intLenLabel)
End If
End If
ParseTextLinePair = Trim(stime)
End Function
Function makedate(stime) As Date
If IsDate(stime) Then
makedate = format(stime, "mm/dd/yyyy HH:mm AMPM")
Else
makedate = Now
End If
End Function
Snippet from e-mail body:
The following RFC has been assigned to you by the Change Management System.
RFC Details:
Priority: 4 - Low
RFC #: RFC-000114
Category: Upgrade
Risk:
HYPERLINK "Link to ticket" Click here to view the ticket
Due Date: 12/5/2012 7:00:00 PM CST
Scheduled Start: 12/5/2012 1:00:00 PM CST
Scheduled Finish: 12/5/2012 2:00:00 PM CST
Summary: Upgrade to 5 dot something or other
So far I have managed to create a macro that will create an appointment and pop up a reminder, but I cannot get the time of the appointment set based on the time variables in the e-mail body.
Any assistance or insight anyone can offer will be greatly appreciated.
The macro I have is below and below that is a snippet from the body of the e-mails we receive.
Macro:
Sub NewMeetingRequestFromEmail2(item As Outlook.MailItem)
Dim email As MailItem
Set email = item
Dim meetingRequest As AppointmentItem
Dim stime As String
Dim etime As String
Set meetingRequest = Application.CreateItem(olAppointmentItem)
meetingRequest.MeetingStatus = olMeeting
meetingRequest.Body = email.Body
meetingRequest.Subject = email.Subject
stime = ParseTextLinePair(email.Body, "Scheduled Start:")
etime = ParseTextLinePair(email.Body, "Scheduled Finish:")
meetingRequest.Start = makedate(stime)
meetingRequest.End = makedate(etime)
meetingRequest.ReminderSet = True
meetingRequest.ReminderMinutesBeforeStart = 300
meetingRequest.Save
End Sub
Function ParseTextLinePair _
(strSource As String, strLabel As String)
Dim intLocLabel As Integer
Dim intLocCRLF As Integer
Dim intLenLabel As Integer
Dim stime As String
intLocLabel = InStr(strSource, strLabel)
intLenLabel = Len(strLabel)
If intLocLabel > 0 Then
intLocCRLF = InStr(intLocLabel, strSource, vbCrLf)
If intLocCRLF > 0 Then
intLocLabel = intLocLabel + intLenLabel
stime = Mid(strSource, _
intLocLabel, _
intLocCRLF - intLocLabel)
Else
intLocLabel = _
Mid(strSource, intLocLabel + intLenLabel)
End If
End If
ParseTextLinePair = Trim(stime)
End Function
Function makedate(stime) As Date
If IsDate(stime) Then
makedate = format(stime, "mm/dd/yyyy HH:mm AMPM")
Else
makedate = Now
End If
End Function
Snippet from e-mail body:
The following RFC has been assigned to you by the Change Management System.
RFC Details:
Priority: 4 - Low
RFC #: RFC-000114
Category: Upgrade
Risk:
HYPERLINK "Link to ticket" Click here to view the ticket
Due Date: 12/5/2012 7:00:00 PM CST
Scheduled Start: 12/5/2012 1:00:00 PM CST
Scheduled Finish: 12/5/2012 2:00:00 PM CST
Summary: Upgrade to 5 dot something or other