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

因爲它還沒有保存