根据主题

Question

我正在自动创建Outlook中的任务。

我希望此代码在我点击发送电子邮件后询问是否要创建任务。我希望它只询问电子邮件是否有特定的标题。我们使用“＃CT-”作为创造任务的能指。

原始代码可以在这里找到：

https://www.slipstick.com/developer/code-samples/create-task-sending-message/

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)

Dim intRes As Integer
Dim strMsg As String
Dim objTask As TaskItem
Set objTask = Application.CreateItem(olTaskItem)
Dim strRecip As String
Dim itm As MailItem

With itm
    .subject = "#CT-"
End With

If itm.subject Like "#CT-" Then
    strMsg = "Do you want to create a task for this message?"
    intRes = MsgBox(strMsg, vbYesNo + vbExclamation, "Create Task")
End If

If intRes = vbNo Then
    Cancel = False
Else

    For Each Recipient In Item.Recipients
        strRecip = strRecip & vbCrLf & Recipient.Address
    Next Recipient

    With objTask
        .Body = Item.Body
        .subject = Item.subject
        .DueDate = Item.ReceivedTime + 28
        .ReminderSet = True
        .ReminderTime = Item.ReceivedTime + 7
        .Save
    End With

    Cancel = False

End If

Set objTask = Nothing

End Sub

Answer 1

您不需要新的itm - 您希望使用Item参数，以查看其subject是否以您的指示符开头。您可以使用Left上的subject函数查看它是否与您的能指一致。

编辑：如果要将任务保存在默认“待办事项列表”文件夹以外的文件夹中，则可以在保存后.Move任务。

Option Explicit

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)

Dim strMsg As String
Dim objTask As TaskItem
Set objTask = Application.CreateItem(olTaskItem)
Dim strSignifier As String
Dim ns As Outlook.NameSpace
Dim inquiries As Folder

Set ns = Application.GetNamespace("MAPI")

On Error GoTo FolderError:
' Inquiries is a subfolder of Inbox
Set inquiries = ns.GetDefaultFolder(olFolderInbox).Folders("Inquiries")
On Error GoTo 0

strSignifier = "#CT-"
strMsg = "Do you want to create a task for this message?"

If TypeOf Item Is Outlook.MailItem Then
    If Left(Item.Subject, Len(strSignifier)) = strSignifier Then
        If MsgBox(strMsg, vbYesNo + vbExclamation, "Create Task") = vbYes Then
            With objTask
                .Body = Item.Body
                .Subject = Item.Subject
                .DueDate = Item.ReceivedTime + 28
                .ReminderSet = True
                .ReminderTime = Item.ReceivedTime + 7
                .Save 'to default folder
                .Move inquiries
            End With
        End If
    End If
End If

Set objTask = Nothing
Exit Sub

FolderError:
    MsgBox "Unable to find the Inquiries folder - cannot save this email as a task."

End Sub

Answer 2

非常接近确实，您可以选择使用相同的代码，但

1.您需要使用strSubject属性

将主题存储在Item.Subject中

2.将结果与＆＃34; #CT - ＆＃34;

进行比较

3.如果比较成功，则指定您需要采取的行动。

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)

Dim intRes As Integer
Dim strMsg As String
Dim objTask As TaskItem
Set objTask = Application.CreateItem(olTaskItem)
Dim strRecip As String
Dim itm As MailItem
Dim strSubject As String

strSubject = Item.Subject



  If strSubject Like "#CT-" Then
    strMsg = "Do you want to create a task for this message?"
    intRes = MsgBox(strMsg, vbYesNo + vbExclamation, "Create Task")
  End If

    If intRes = vbNo Then
      Cancel = False

    Else

    For Each Recipient In Item.Recipients
        strRecip = strRecip & vbCrLf & Recipient.Address
    Next Recipient

With objTask
    .Body = Item.Body
    .subject = Item.subject
    .DueDate = Item.ReceivedTime + 28
    .ReminderSet = True
    .ReminderTime = Item.ReceivedTime + 7
    .Save
End With