使用预定义模板回复电子邮件时从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