使用預定義模板回覆電子郵件時從Outlook電子郵件正文中提取單詞

Question

我有一個工作代碼正在從初始電子郵件主題中提取信息。

Sub InitialNotif() 

Dim origEmail As MailItem 

Dim replyEmail As MailItem 

Dim INC1 As String 'For Serial Number 

Dim INo As Integer 'For Serial Number 

Dim LOC1 As String 'For Location 

Dim LoC As Integer 'For Location 

Dim SUMM As String 'For Summary 

Dim Sum As Integer 'For Summary 

Set origEmail = Application.ActiveWindow.Selection.item(1) 

Set replyEmail = Application.CreateItemFromTemplate("H:\Documents\Test P1-.oft") 

replyEmail.CC = "" 

replyEmail.HtmlBody = replyEmail.HtmlBody & origEmail.Reply.HtmlBody 

INC1 = origEmail.Subject 

INo = InStr(1, INC1, "SR2") 

LOC1 = origEmail.Subject 

LoC= InStr(1, LOC1, "|") + 10 

SUMM= origEmail.Subject 

Sum= InStr(1, SUMM, "Summary") + 30 

replyEmail.Subject = " <P1> - " & INC1 

replyEmail.HtmlBody = Replace(replyEmail.HtmlBody, "INC1", INC1) 

replyEmail.Display 

End Sub 

現在我想從電子郵件正文獲取信息。以下是電子郵件正文的格式。

Serial Number: SR23443354 
Location: Canada 
Summary: Replacement request 

我需要上面的信息與我.otf模板來代替。所以當我運行腳本時，它應該自動填充或替換必填字段。

模板正文：

Serial Number: INC1 
Location: LOC 
Summary: SUMM 

當我試圖用origEmail.body更換origEmail.Subject它給我散格式整個郵件。

Answer 1

變化ActiveWindow隨着ActiveExplorer

MSDN Split Function

MSDN Replace Function

MSDN InStr Function

Option Explicit 
Sub InitialNotif() 
    Dim OrigEmail As MailItem 
    Dim ReplyEmail As MailItem 
    Dim vText As Variant 
    Dim vItem As Variant 
    Dim SerialNum As String 
    Dim Location As String 
    Dim Summary As Variant 
    Dim i As Long 

    If Application.ActiveExplorer.Selection.Count = 0 Then 
     MsgBox ("No Item selected") 
     Exit Sub 
    End If 

    Set OrigEmail = Application.ActiveExplorer.Selection.Item(1) 
    Set ReplyEmail = Application.CreateItemFromTemplate("C:\Temp\Untitled.oft") 

    '// for the Subject 
    '// SR23443354|Replacement request = Bla Bla SR23443354|- Open 
    ReplyEmail.Subject = "Bla Bla " & "|" _ 
            & Split(OrigEmail.Subject, "|")(0) _ 
            & " - Open" 

    '// Process Mail body 
    '// Get the text of the message 
    '// and split it by paragraph 
    vText = Split(OrigEmail.Body, Chr(13)) ' Chr(13)) carriage return 

' '// Check each line of text in the message body 
    For i = UBound(vText) To 0 Step -1 

     '// locate the text relating to the item required 
     '// Serial Number: 
     If InStr(1, vText(i), "Serial Number") > 0 Then 
      '// Split text line From ":" 
      vItem = Split(vText(i), Chr(58)) ' Chr(58) = : 
      SerialNum = vItem(1) 
      Debug.Print SerialNum ' Print Immediate Window 
     End If 

     '// Location: 
     If InStr(1, vText(i), "Location") > 0 Then 
      vItem = Split(vText(i), Chr(58)) 
      Location = vItem(1) 
     End If 

     '// Summary: 
     If InStr(1, vText(i), "Summary") > 0 Then 
      vItem = Split(vText(i), Chr(58)) 
      Summary = vItem(1) 
     End If 
    Next 

' '// Now Update oft file 
    With ReplyEmail 
     .Body = Replace(.Body, "INC1", SerialNum) 
     .Body = Replace(.Body, "LOC", Location) 
     .Body = Replace(.Body, "SUMM", Summary) 
    End With 

    ReplyEmail.CC = "" 
    ReplyEmail.Display 

    Set OrigEmail = Nothing 
    Set ReplyEmail = Nothing 
End Sub