Question

我创建了一个脚本来通过电子邮件创建任务：

我的代码是：

Sub MakeTaskFromMail2(MyMail As Outlook.MailItem)
    Dim strID As String
    Dim olNS As Outlook.NameSpace
    Dim olMail As Outlook.MailItem
    Dim objTask As Outlook.TaskItem
    strID = MyMail.EntryID
    Set olNS = Application.GetNamespace("MAPI")
    Set olMail = olNS.GetItemFromID(strID)
    Set objTask = Application.CreateItem(olTaskItem)

'    Adjust Subject to remove School:
    Dim sInput As String
    Dim sOutput As String
    sInput = olMail.subject
    sOutput = Mid(sInput, InStr(sInput, "School:") + 8)

'    Get the due date from the body
'    Dim dInput As String
'    Dim dOutput As String
'    dInput = olMail.Body
'    dOutput = Mid(dInput, InStr(dInput, "Due:") + 10)

'    Set the task
    With objTask
        .subject = sOutput
        .DueDate = olMail.SentOn
'        .DueDate = dOutput
        .Body = olMail.Body
    End With
    Call CopyAttachments(olMail, objTask)
    objTask.Save
    Set objTask = Nothing
    Set olMail = Nothing
    Set olNS = Nothing
End Sub

所有评论的部分都是我添加的内容，用于尝试从电子邮件正文中获取截止日期。

电子邮件的正文如下所示：

Ticket ID: 3479
Ticket Title: display is now Green and pixelated

Room: 110
Priority: Medium
Due: 2013-12-11

如何在正文中找到截止日期并将其设置为任务的截止日期？

Answer 1

试试这个（UNTESTED）

'
'~~> Rest of your code
'

Dim strData() As String, tmpString As String
Dim dOutput As Date
Dim tmpAr
Dim i As Long

dInput = olMail.Body
strData() = Split(dInput, vbCrLf)

For i = LBound(strData) To UBound(strData)
    If InStr(1, strData(i), "Due:", vbTextCompare) Then
        tmpAr = Split(strData(i), "Due:")
        tmpString = Left(Trim(tmpAr(1)), 10)
        dOutput = DateValue(tmpString)
        Exit For
    End If
Next i

If dOutput = "" Then
    MsgBox "Date not Found"

    Exit Sub
End If

With objTask
    .Subject = sOutput
    .DueDate = olMail.SentOn
    .DueDate = dOutput
    .Body = olMail.Body
End With

'
'~~> Rest of your code
'

在字符串＆amp;中查找文字设定日期

1 个答案: