Outlook VB Script to Create Task From Email - not creating task - vba

Question

I've got the following script which should for all that I can see, work without issue (and in fact at one point yesterday was working - but I must have inadvertently changed something when trying to clean up the code because it's no longer working today).
Perhaps another set of eyes can help me. I have a rule setup to set these emails into their own folder and run the script in Outlook. That works without issue - the issue comes from the script itself.
The subject of the emails that come in that get filtered are generally something like this:
"Ticket: 328157 School: BlahBlah Issues: Problems with flux capacitor"
The idea is that the script will create a task with the appropriate priority level and put it in the appropriate category (and include just the stuff in the subject after 'School"' because the ticket # is not important).
Here is the script:
Sub MakeTaskFromMail(MyMail As Outlook.MailItem)
Dim strID As String
Dim olNS As Outlook.NameSpace
Dim olMail As Outlook.MailItem
Dim objTask As Outlook.TaskItem
'Get Specific Email based on ID
strID = MyMail.EntryID
Set olNS = Application.GetNamespace("MAPI")
Set olMail = olNS.GetItemFromID(strID)
Set objTask = Application.CreateItem(olTaskItem)
'**************************
'*****SET TASK SUBJECT*****
'**************************
Dim sInput As String
Dim sOutput As String
'get the email subject
sInput = olMail.Subject
'get all the text after School: in the subject
sOutput = Mid(sInput, InStr(sInput, "School:") + 8)
Dim priorityUrgentString As String
Dim priorityHighString As String
Dim priorityMediumString As String
Dim priorityLowString As String
'Set Priority Strings to check for to determine category
priorityUrgentString = "Priority: Urgent"
priorityHighString = "Priority: High Priority"
priorityMediumString = "Priority: Medium"
priorityLowString = "Priority: Project"
'check to see if ticket is Urgent
'if urgent - due date is today and alert is set for 8am
If InStr(olMail.Body, priorityUrgentString) <> 0 Then
With objTask
.Subject = sOutput
.DueDate = olMail.SentOn
.Body = olMail.Body
.Categories = "Urgent"
.Importance = olImportanceHigh
.ReminderSet = True
.ReminderTime = objTask.DueDate
End With
'check to see if ticket is High Priority
'if High Priority - due date is today - alert is set for 8am
ElseIf InStr(olMail.Body, priorityHighString) <> 0 Then
With objTask
.Subject = sOutput
.DueDate = olMail.SentOn + 2
.Body = olMail.Body
.Categories = "High"
.Importance = olImportanceHigh
.ReminderSet = True
.ReminderTime = objTask.DueDate + 2
End With
'check to see if its a medium priority
'if medium - due date is set for 7 days, no alert
ElseIf InStr(olMail.Body, priorityMediumString) <> 0 Then
With objTask
.Subject = sOutput
.DueDate = olMail.SentOn + 7
.Body = olMail.Body
.Categories = "Medium"
.Importance = olImportanceNormal
End With
'check to see if its a project priority
'if project - due date is set for 21 days, no alert
ElseIf InStr(olMail.Body, priorityLowString) <> 0 Then
With objTask
.Subject = sOutput
.DueDate = olMail.SentOn + 21
.Body = olMail.Body
.Categories = "Project"
.Importance = olImportanceLow
End With
End If
'Copy Attachments
Call CopyAttachments(olMail, objTask)
'Save Task
objTask.Save
Set objTask = Nothing
Set olMail = Nothing
Set olNS = Nothing
End Sub
Sub CopyAttachments(objSourceItem, objTargetItem)
Set fso = CreateObject("Scripting.FileSystemObject")
Set fldTemp = fso.GetSpecialFolder(2) ' TemporaryFolder
strPath = fldTemp.Path & "\"
For Each objAtt In objSourceItem.Attachments
strFile = strPath & objAtt.FileName
objAtt.SaveAsFile strFile
objTargetItem.Attachments.Add strFile, , , objAtt.DisplayName
fso.DeleteFile strFile
Next
Set fldTemp = Nothing
Set fso = Nothing
End Sub

Answer 1

What I can see without running the script is this:
You will have to save the TaskItem, after setting it (use .Save as the last line within the With)
Also, you will probably have to set the ReminderTime matching the mailitem
.ReminderTime = olMail.SentOn
instead of
.ReminderTime = objTask.DueDate
because it isn't saved yet