Selecting delineated text in Outlook

[TimCor]

Good day all
Outlook 2007
I am a real beginner at VBA but have managed to get almost everything from web sources. I have standard incoming emails which I select and a macro that transfers everything to an Excel spreadsheet, and loads them under column letters. My email has one line with Product : Quantity : Price followed by the next line with the actual product, quantity and price. Each item is delineated by a colon. (The product description will vary in length)

How do I code my loop to look at these three items and transfer them to columns K L and M in my spreadsheet ??

SAMPLE OF INCOMING MESSAGE

For payment by :
' ==============Section that I need help with

Product : Quantity : Price
products here : 1 : 263.00

'========== to here

Voucher : -0.00

Continues from here OK


Example part of the VBA loop in use below.

If InStr(1, vText(i), "For payment by: ") > 0 Then
vItem = Split(vText(i), Chr(58))
xlSheet.Range("G" & rCount) = Trim(vItem(1))
End If

'=============================================
'This is the section that needs looking at

If InStr(1, vText(i), "Product :") > 0 Then
vItem = Split(vText(i), Chr(58))
xlSheet.Range("H" & rCount) = Trim(vItem(1))
End If

If InStr(1, vText(i), "Quantity :") > 0 Then
vItem = Split(vText(i), Chr(58))
xlSheet.Range("I" & rCount) = Trim(vItem(1))
End If

If InStr(1, vText(i), "Price :") > 0 Then
vItem = Split(vText(i), Chr(58))
xlSheet.Range("J" & rCount) = Trim(vItem(1))
End If

If InStr(1, vText(i), "Product2 :") > 0 Then
vItem = Split(vText(i), Chr(58))
xlSheet.Range("K" & rCount) = Trim(vItem(1))
End If

If InStr(1, vText(i), "Quantity2:") > 0 Then
vItem = Split(vText(i), Chr(58))
xlSheet.Range("L" & rCount) = Trim(vItem(1))
End If

If InStr(1, vText(i), "Price 2 :") > 0 Then
vItem = Split(vText(i), Chr(58))
xlSheet.Range("M" & rCount) = Trim(vItem(1))
End If


' =============================================
' All works from here onwards

If InStr(1, vText(i), "Voucher :") > 0 Then
vItem = Split(vText(i), Chr(58))
xlSheet.Range("O" & rCount) = Trim(vItem(1))
End If

Endlessly grateful for any assistance

TimCor

[Charlize]

Couple questions :
1. Does the product description always starts at the same line
2. Can there be more products
3. Is that an exact sample of the body of a message

Charlize

ps.: maybe extract this info to textfiles and number them sequentially in a specific folder. Then in excel, you import those textfiles. Since you saved the info the way you wanted it, it's easier to get them into excel (each product a line in the file and info on a line seperated by : ) .

[TimCor]

Good day Charlize
Many thanks for takingthe trouble to reply, and possibly help.

1. The incoming format is always the same

2. However there may be more than one row of products/quantity/prices (but I did not include this previously as being too much to ask)

3. The total incoming message (with added one extra product) is like this


Username : 68888888
Date : 26 Oct 2012 - 08:28
Shopper Id : 888888
IP number : 00.000.00.000
For payment by: Sample


Product : Quantity : Price
Standard machine : 1 : 230.00
Best machine : 2 : 480.00

Voucher : -0.00
Discount : -0.00
Subtotal : 230.00
Shipping : 0.00
Tax : 0.00
TOTAL : 710.00

Invoice to:
Inv Name : Steve Bloggs
Inv Company : Company here
Inv Address : Address here
Inv City : TOWN
Inv State : STATE
Inv Pst Code: Post Code
Inv Country : United Kingdom

Tel : 00000000000
Fax : FAX NUMBER
Email : here is the email

Deliver to:
Ship Name : Customer name
Ship Company : Company
Ship Address : At home
Ship City : TOWN
Ship State : State
Ship Pst Code: TQ5
Ship Country : England
Ship Tel : 999999

====================

This needs to be transferred to a spreadsheet when I highlight the message and click on a macro button in Outlook 2007. For information this spreadsheet is linked to a database where another macro can be run to add it into the main table with a special unique number. All works fine except the product section.

Many thanks again

Tim Cor

[Charlize]

Something like this ?
Sub Get_Products()
'the mailmessage that's selected
Dim mymessage As Outlook.MailItem
'the text of the message, the array's for message and product
Dim thebody As String, mytext, myproduct
'theloop = looping through lines of message, theproduct = single product
Dim theloop As Long, theproduct As String
'set the selected message to the active one
Set mymessage = ActiveExplorer.Selection.item(1)
'store the messagebody to the variable
thebody = mymessage.Body
'split the message by using end of line character
mytext = Split(thebody, vbCrLf)
'loop through all the lines of the message
For theloop = LBound(mytext) To UBound(mytext)
'if a certain line contains this = 1 then go for it
If InStr(mytext(theloop), "Product : Quantity : Price") > 0 Then
'add 1 to loop because we start from next line
theloop = theloop + 1
'loop through the products until next line is empty
Do While mytext(theloop) <> vbNullString
'split the product line by using the :
myproduct = Split(mytext(theloop), ":")
'make up a display. Here you need to code the action you want
theproduct = theproduct & myproduct(0) & " - " & myproduct(1) & " - " & myproduct(2) & vbCrLf
'next product
theloop = theloop + 1
Loop
End If
'proceed to next line of message after we did our thing with the products
'for now, we do nothing with it
Next theloop
'display the result in a messagebox
MsgBox theproduct
End SubCharlize

[TimCor]

Many thanks for this work Charlize. I am now away for a few days but will try this when I return, and get back to you then.
All the best TimCor