查找文本字符串和設置

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

試試這個（未經測試）

' 
'~~> 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 
'