Outlook and Excel

  • Thread starter praetorian_prefect_2004
  • Start date
P

praetorian_prefect_2004

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
 
B

Bernie Deitrick

Add these lines:

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

after this line:

sBody = msg.Body


HTH,
Bernie
MS Excel MVP
 
B

Bernie Deitrick

Oops, you would need to change

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

to

Set r = [a65536].End(xlUp).Offset(1).Resize(, 6)

Sorry about that...

HTH,
Bernie
MS Excel MVP


Bernie Deitrick said:
Add these lines:

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

after this line:

sBody = msg.Body


HTH,
Bernie
MS Excel MVP


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
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads


Top