Add these lines:

r(5).Value = msg.ReceivedTime
r(6).Value = msg.Subject

after this line:

sBody = msg.Body


HTH,
Bernie
MS Excel MVP


" wrote in message
oups.com...
I need expert help. This code searches four lines in the body of the
email, and copies it to excel by column. I would like to add two more
columns where the date email was received and email subject are also
included.

Sub bodyStrip(msg As Outlook.MailItem)
Dim sBody As String
Dim aFields As Variant
Dim r As Range
Dim n&, iPos1&, ipos2&


aFields = Array("Order Number:", "UIC ID:", "UIC Short Name:", "Order
Status:")


Set r = [a65536].End(xlUp).Offset(1).Resize(, 4)
sBody = msg.Body


For n = 1 To 4
iPos1 = InStr(ipos2 + 1, sBody, aFields(n - 1))
If iPos1 0 Then
iPos1 = iPos1 + Len(aFields(n - 1))
ipos2 = InStr(iPos1 + 1, sBody, vbCrLf)
r(n) = Mid(sBody, iPos1, ipos2 - iPos1)
Cells.Columns.AutoFit
Else
Exit For
End If
Next

End Sub