Outlook VB脚本创建任务从电子邮件 - 不创建任务

Question

我有以下脚本，应该为我所能看到的所有工作，没有问题的工作（事实上昨天在一个点上工作 - 但我必须无意中在尝试清理代码时因此而改变了一些内容，因为它现在不再有效）。

也许另一组眼睛可以帮助我。我有一个规则设置将这些电子邮件设置到他们自己的文件夹并在Outlook中运行脚本。这没有问题 - 问题来自脚本本身。

而来的是那些获得过滤邮件的主题通常是这样的：

“门票：328157学校：BlahBlah问题：用焊剂电容问题”

的想法是，该脚本将创建具有适当优先级的任务，并把它放在适当的类别（和仅包含的东西，在“学校“”因为机票＃不重要后受试者）

下面是脚本：

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

什么，而不运行脚本，我可以看到的是：

你将不得不拯救TaskItem，将其设置（使用.Save因为随着内的最后一行）

而且后，你会可能要设置ReminderTime匹配的MailItem

.ReminderTime = olMail.SentOn

，而不是

.ReminderTime = objTas k.DueDate

因为它还没有保存