Question

我已经得到了以下脚本，应该为我能看到的所有内容工作，没有问题（实际上昨天有一点工作 - 但是在尝试清理代码时我必须无意中改变了一些东西，因为它今天不再工作了。）

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

过滤后收到的电子邮件的主题通常是这样的：

＆＃34;票证：328157学校：BlahBlah问题：助焊剂电容器的问题＆＃34;

我们的想法是，该脚本将创建一个具有适当优先级的任务，并将其放入适当的类别（并且在学校＆＃34之后仅包括主题中的内容;＆＃39;因为票证＃并不重要。）

这是脚本：

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作为With中的最后一行）

此外，您可能必须设置与mailitem匹配的ReminderTime

.ReminderTime = olMail.SentOn

而不是

.ReminderTime = objTask.DueDate

因为它尚未保存

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

1 个答案: