I am getting quite good at VBA for Excel but have never written VBA code for
Outlook, yet we have been asked the following..

Quote:
Not sure who is the macro guru in your team for outlook but could you get
them to try to do the following:

If an emails comes in with following text (this will not be in from, sent,
to, subject boxes but in main message [body] ):

First email:
Code: RECS
From: US11283
Version: Draft
Email:
Date: 03/02/2007 08:38
Content: Please find attached draft file for the rec

Second email:
Code: RECS
From: US11283
Version: Final
Email:
Date: 03/02/2007 16:54
Content: Please find attached final file for the rec


Can you set up a macro that:
1. moves all emails with code “RECS� to a new inbox called RECONCILIATION

2. checks all emails in RECONCILIATION BOX against each other. If any have
same “From:� e.g. LV11283 and the later date one has the Version “Final� then
move these emails to a different inbox called MATCHED


3. If after x minutes from “draft� email being sent the “final� has not
turned up can you set it so the system will send out an email to the email in
“email� saying
To [FROM]. You have sent an email [CONTENT] but this is [VERSION]. Please
send a revised version

4. Draft email and the new sent one then get moved to a UNMATCHED inbox.

:End quote

I know that point 1. can be covered by a 'rule' but as for the rest of it
I’m not getting far..

I have previously written an EXCEL project that looks at all of the emails
in a particular folder, lists particular details of the ones matching certain
criteria and then makes pivot tables and stuff.
Since receiving the request above I have adapted this and been able to move
emails from one folder to another. I could possibly - using 'find', text
manipulation and a lot of time to research/experiment - pull out the various
bits of information I need to compare.
I have also sent emails from outlook using Excel VBA (although I cannot get
any form or combination of 'Chr(13)', 'Chr(10)', 'vbNewLine', 'vbCr', 'vbLf'
or 'vbCrLf' to make any difference between strings of text in the Body of the
text..??? (OL & XL 2000)).

However it would obviously be better to have the macro in Outlook being
triggered by new mail being received in the appropriate folder rather than a
macro that needs to be triggered manually from Excel.

Any help would be appreciated!

Thank you in advance

Damon

You can handle the ItemAdd event on the Items collection of the Inbox to
handle new mails coming in. See
http://www.outlookcode.com/d/code/zaphtml.htm#cw for an example of an
ItemAdd handler.

Whatever you end up doing is going to be a string parsing exercise. You can
get the item.Body to get the text, from there you have to parse it yourself.
For HTML emails you can use HTMLBody. For HTML emails a newline (0x0D 0x0A)
won't work. You need to use HTML tags and for a newline that would be
"br".

Note that reading Body or HTMLBody is restricted for security reasons, you
can write them without any restrictions but reading them could be a way of
harvesting email addresses so it's restricted. In Outlook 2003 if you use a
COM addin and derive all your Outlook objects from the Application object
passed in OnConnection you're OK. Deploying macros (Outlook VBA code) is not
a recommended best practice, see
http://www.outlookcode.com/d/distributevba.htm.

For more information about the Outlook security see
http://www.outlookcode.com/d/sec.htm.

--
Ken Slovak
[MVP - Outlook]
http://www.slovaktech.com
Author: Absolute Beginner's Guide to Microsoft Office Outlook 2003
Reminder Manager, Extended Reminders, Attachment Options
http://www.slovaktech.com/products.htm


"Damon" wrote in message
...
I am getting quite good at VBA for Excel but have never written VBA code
for
Outlook, yet we have been asked the following..

Quote:
Not sure who is the macro guru in your team for outlook but could you get
them to try to do the following:

If an emails comes in with following text (this will not be in from, sent,
to, subject boxes but in main message [body] ):

First email:
Code: RECS
From: US11283
Version: Draft
Email:
Date: 03/02/2007 08:38
Content: Please find attached draft file for the rec

Second email:
Code: RECS
From: US11283
Version: Final
Email:
Date: 03/02/2007 16:54
Content: Please find attached final file for the rec


Can you set up a macro that:
1. moves all emails with code “RECS� to a new inbox called RECONCILIATION

2. checks all emails in RECONCILIATION BOX against each other. If any have
same “From:� e.g. LV11283 and the later date one has the Version “Final�
then
move these emails to a different inbox called MATCHED


3. If after x minutes from “draft� email being sent the “final� has not
turned up can you set it so the system will send out an email to the email
in
“email� saying
To [FROM]. You have sent an email [CONTENT] but this is [VERSION]. Please
send a revised version

4. Draft email and the new sent one then get moved to a UNMATCHED inbox.

:End quote

I know that point 1. can be covered by a 'rule' but as for the rest of it
I’m not getting far..

I have previously written an EXCEL project that looks at all of the emails
in a particular folder, lists particular details of the ones matching
certain
criteria and then makes pivot tables and stuff.
Since receiving the request above I have adapted this and been able to
move
emails from one folder to another. I could possibly - using 'find', text
manipulation and a lot of time to research/experiment - pull out the
various
bits of information I need to compare.
I have also sent emails from outlook using Excel VBA (although I cannot
get
any form or combination of 'Chr(13)', 'Chr(10)', 'vbNewLine', 'vbCr',
'vbLf'
or 'vbCrLf' to make any difference between strings of text in the Body of
the
text..??? (OL & XL 2000)).

However it would obviously be better to have the macro in Outlook being
triggered by new mail being received in the appropriate folder rather than
a
macro that needs to be triggered manually from Excel.

Any help would be appreciated!

Thank you in advance

Damon

Ken,

Earlier I type what turned out to be quite a long reply to this but I got
blue screened and lost it all.

In short, thank you for the link to the ItemAdd example and the HTML code
for a new line. I have now got a simple macro to run on receipt of a new
email which is a great starting point and I can now add some aesthetic
formating to emails composed with VBA.

Thank you again
"Ken Slovak - [MVP - Outlook]" wrote:

You can handle the ItemAdd event on the Items collection of the Inbox to
handle new mails coming in. See
http://www.outlookcode.com/d/code/zaphtml.htm#cw for an example of an
ItemAdd handler.

Whatever you end up doing is going to be a string parsing exercise. You can
get the item.Body to get the text, from there you have to parse it yourself.
For HTML emails you can use HTMLBody. For HTML emails a newline (0x0D 0x0A)
won't work. You need to use HTML tags and for a newline that would be
"br".

Note that reading Body or HTMLBody is restricted for security reasons, you
can write them without any restrictions but reading them could be a way of
harvesting email addresses so it's restricted. In Outlook 2003 if you use a
COM addin and derive all your Outlook objects from the Application object
passed in OnConnection you're OK. Deploying macros (Outlook VBA code) is not
a recommended best practice, see
http://www.outlookcode.com/d/distributevba.htm.

For more information about the Outlook security see
http://www.outlookcode.com/d/sec.htm.

--
Ken Slovak
[MVP - Outlook]
http://www.slovaktech.com
Author: Absolute Beginner's Guide to Microsoft Office Outlook 2003
Reminder Manager, Extended Reminders, Attachment Options
http://www.slovaktech.com/products.htm


"Damon" wrote in message
...
I am getting quite good at VBA for Excel but have never written VBA code
for
Outlook, yet we have been asked the following..

Quote:
Not sure who is the macro guru in your team for outlook but could you get
them to try to do the following:

If an emails comes in with following text (this will not be in from, sent,
to, subject boxes but in main message [body] ):

First email:
Code: RECS
From: US11283
Version: Draft
Email:
Date: 03/02/2007 08:38
Content: Please find attached draft file for the rec

Second email:
Code: RECS
From: US11283
Version: Final
Email:
Date: 03/02/2007 16:54
Content: Please find attached final file for the rec


Can you set up a macro that:
1. moves all emails with code “RECS� to a new inbox called RECONCILIATION

2. checks all emails in RECONCILIATION BOX against each other. If any have
same “From:� e.g. LV11283 and the later date one has the Version “Final�
then
move these emails to a different inbox called MATCHED


3. If after x minutes from “draft� email being sent the “final� has not
turned up can you set it so the system will send out an email to the email
in
“email� saying
To [FROM]. You have sent an email [CONTENT] but this is [VERSION]. Please
send a revised version

4. Draft email and the new sent one then get moved to a UNMATCHED inbox.

:End quote

I know that point 1. can be covered by a 'rule' but as for the rest of it
I’m not getting far..

I have previously written an EXCEL project that looks at all of the emails
in a particular folder, lists particular details of the ones matching
certain
criteria and then makes pivot tables and stuff.
Since receiving the request above I have adapted this and been able to
move
emails from one folder to another. I could possibly - using 'find', text
manipulation and a lot of time to research/experiment - pull out the
various
bits of information I need to compare.
I have also sent emails from outlook using Excel VBA (although I cannot
get
any form or combination of 'Chr(13)', 'Chr(10)', 'vbNewLine', 'vbCr',
'vbLf'
or 'vbCrLf' to make any difference between strings of text in the Body of
the
text..??? (OL & XL 2000)).

However it would obviously be better to have the macro in Outlook being
triggered by new mail being received in the appropriate folder rather than
a
macro that needs to be triggered manually from Excel.

Any help would be appreciated!

Thank you in advance

Damon

Okay so using the ItemAdd example from the link provided by Ken, and another
bit of example code from Sue Mosher for parsing data pairs (very useful! see
'Function ParseTextLinePair' in 'code so far..' below), I have got quite far..

The macro triggers upon receipt of an email in a particular folder, checks
for 'Draft' or 'Final' version and if 'Final' matches the email to the
'draft' version then moves both.

So next bit I am currently stuck on is how to reply to an email after x
minutes (Lets say 20 mins) if the 'final' version has not turned up to be
matched off. It seems that 'OnTime' is an excel only VBA function, does
Outlook have an equivalent? or is there another way I can do this?

Thank you in advance

Quote from original request:-

"3. If after x minutes from “draft� email being sent the “final� has not
turned up can you set it so the system will send out an email to the email in
“email� saying To [FROM]. You have sent an email [CONTENT] but this is
[VERSION]. Please send a revised version

4. Draft email and the new sent one then get moved to a UNMATCHED inbox."


Code So Far...

Option Explicit

Private WithEvents olRecboxItems As Items

Private Sub Application_Startup()

Dim objNS As NameSpace
Dim DesFldr As MAPIFolder

Set objNS = Application.GetNamespace("MAPI")
' instantiate objects declared WithEvents
Set olRecboxItems = objNS.Folders("Mailbox - One, Some").Folders _
("Inbox").Folders("reconciliation").Items

Set objNS = Nothing
End Sub

Private Sub olRecboxItems_ItemAdd(ByVal Item As Object)

'Dim VerType As Integer
Dim NVersionType As String
Dim NWhoFrom As String
Dim NDateSent As String
Dim ExistItem As Variant
Dim ExVersionType As String
Dim ExWhoFrom As String
Dim ExDateSent As String
Dim MesgText As String
Dim objNS As NameSpace
Dim DesFldr As MAPIFolder

Set objNS = Application.GetNamespace("MAPI")
Set DesFldr = objNS.Folders("Mailbox - One, Some").Folders("Inbox") _
.Folders("reconciliation").Folders("Matched")
Set objNS = Nothing

'On Error Resume Next

'VerType = Item.Body Like "*Draft*" 'works with Case True/False

NVersionType = ParseTextLinePair(Item.Body, "Version:")
NWhoFrom = ParseTextLinePair(Item.Body, "From:")
‘NDateSent = ParseTextLinePair(Item.Body, "Date:")

Select Case NVersionType

Case Is = "Draft"
MsgBox NVersionType & " Test message(draft)"

Case Is = "Final"
MsgBox NVersionType & " Version - Sent by " & NWhoFrom & " on " _
& NDateSent

If olRecboxItems.Count 1 Then
For Each ExistItem In olRecboxItems
'MsgBox ExistItem.Body
ExVersionType = ParseTextLinePair(ExistItem.Body,
"Version:")
ExWhoFrom = ParseTextLinePair(ExistItem.Body, "From:")
'ExDateSent = ParseTextLinePair(ExistItem.Body, "Date:")

If ExVersionType = "Draft" And ExWhoFrom = NWhoFrom Then
MsgBox ExistItem.Body & vbCr & vbCr & MesgText &
vbCr & _
vbCr & "Matched & Moved"
ExistItem.Move DesFldr
Item.Move DesFldr
Set Item = Nothing
Exit Sub
End If

Next
Else
MsgBox "No messages to compare Error"
Set Item = Nothing
Exit Sub
End If
MsgBox "No Matches"
Case Else
MsgBox "Unknown Version Error"

End Select

Set Item = Nothing
End Sub

Function ParseTextLinePair(strSource As String, strLabel As String)

Dim intLocLabel As Integer
Dim intLocCRLF As Integer
Dim intLenLabel As Integer
Dim strText As String

' locate the label in the source text
intLocLabel = InStr(strSource, strLabel)
intLenLabel = Len(strLabel)
If intLocLabel 0 Then
intLocCRLF = InStr(intLocLabel, strSource, vbCrLf)
If intLocCRLF 0 Then
intLocLabel = intLocLabel + intLenLabel
strText = Mid(strSource, _
intLocLabel, _
intLocCRLF - intLocLabel)
Else
strText = Mid(strSource, intLocLabel + intLenLabel)
End If
End If
ParseTextLinePair = Trim(strText)
End Functio



-----------------------------------------------------------------------------------------------------

"Damon" wrote:

Ken,

Earlier I type what turned out to be quite a long reply to this but I got
blue screened and lost it all.

In short, thank you for the link to the ItemAdd example and the HTML code
for a new line. I have now got a simple macro to run on receipt of a new
email which is a great starting point and I can now add some aesthetic
formating to emails composed with VBA.

Thank you again
"Ken Slovak - [MVP - Outlook]" wrote:

You can handle the ItemAdd event on the Items collection of the Inbox to
handle new mails coming in. See
http://www.outlookcode.com/d/code/zaphtml.htm#cw for an example of an
ItemAdd handler.

Whatever you end up doing is going to be a string parsing exercise. You can
get the item.Body to get the text, from there you have to parse it yourself.
For HTML emails you can use HTMLBody. For HTML emails a newline (0x0D 0x0A)
won't work. You need to use HTML tags and for a newline that would be
"br".

Note that reading Body or HTMLBody is restricted for security reasons, you
can write them without any restrictions but reading them could be a way of
harvesting email addresses so it's restricted. In Outlook 2003 if you use a
COM addin and derive all your Outlook objects from the Application object
passed in OnConnection you're OK. Deploying macros (Outlook VBA code) is not
a recommended best practice, see
http://www.outlookcode.com/d/distributevba.htm.

For more information about the Outlook security see
http://www.outlookcode.com/d/sec.htm.

--
Ken Slovak
[MVP - Outlook]
http://www.slovaktech.com
Author: Absolute Beginner's Guide to Microsoft Office Outlook 2003
Reminder Manager, Extended Reminders, Attachment Options
http://www.slovaktech.com/products.htm


"Damon" wrote in message
...
I am getting quite good at VBA for Excel but have never written VBA code
for
Outlook, yet we have been asked the following..

Quote:
Not sure who is the macro guru in your team for outlook but could you get
them to try to do the following:

If an emails comes in with following text (this will not be in from, sent,
to, subject boxes but in main message [body] ):

First email:
Code: RECS
From: US11283
Version: Draft
Email:
Date: 03/02/2007 08:38
Content: Please find attached draft file for the rec

Second email:
Code: RECS
From: US11283
Version: Final
Email:
Date: 03/02/2007 16:54
Content: Please find attached final file for the rec


Can you set up a macro that:
1. moves all emails with code “RECS� to a new inbox called RECONCILIATION

2. checks all emails in RECONCILIATION BOX against each other. If any have
same “From:� e.g. LV11283 and the later date one has the Version “Final�
then
move these emails to a different inbox called MATCHED


3. If after x minutes from “draft� email being sent the “final� has not
turned up can you set it so the system will send out an email to the email
in
“email� saying
To [FROM]. You have sent an email [CONTENT] but this is [VERSION]. Please
send a revised version

4. Draft email and the new sent one then get moved to a UNMATCHED inbox.

:End quote

I know that point 1. can be covered by a 'rule' but as for the rest of it
I’m not getting far..

I have previously written an EXCEL project that looks at all of the emails
in a particular folder, lists particular details of the ones matching
certain
criteria and then makes pivot tables and stuff.
Since receiving the request above I have adapted this and been able to
move
emails from one folder to another. I could possibly - using 'find', text
manipulation and a lot of time to research/experiment - pull out the
various
bits of information I need to compare.
I have also sent emails from outlook using Excel VBA (although I cannot
get
any form or combination of 'Chr(13)', 'Chr(10)', 'vbNewLine', 'vbCr',
'vbLf'
or 'vbCrLf' to make any difference between strings of text in the Body of
the
text..??? (OL & XL 2000)).

However it would obviously be better to have the macro in Outlook being
triggered by new mail being received in the appropriate folder rather than
a
macro that needs to be triggered manually from Excel.

Any help would be appreciated!

Thank you in advance

Damon

Neither Outlook nor VBA directly support a timer object. You can use a call
to a set of Win32 API's to set up a timer that way, you can add a 3rd party
timer control to a VBA UserForm or add the VB 6 timer control to a UserForm
if you have VB6 installed. You can also run code that checks the system time
and does something xx minutes after a certain time by storing the base time
in a user property in the item and checking that.

--
Ken Slovak
[MVP - Outlook]
http://www.slovaktech.com
Author: Absolute Beginner's Guide to Microsoft Office Outlook 2003
Reminder Manager, Extended Reminders, Attachment Options
http://www.slovaktech.com/products.htm


"Damon" wrote in message
news
Okay so using the ItemAdd example from the link provided by Ken, and
another
bit of example code from Sue Mosher for parsing data pairs (very useful!
see
'Function ParseTextLinePair' in 'code so far..' below), I have got quite
far..

The macro triggers upon receipt of an email in a particular folder, checks
for 'Draft' or 'Final' version and if 'Final' matches the email to the
'draft' version then moves both.

So next bit I am currently stuck on is how to reply to an email after x
minutes (Lets say 20 mins) if the 'final' version has not turned up to be
matched off. It seems that 'OnTime' is an excel only VBA function, does
Outlook have an equivalent? or is there another way I can do this?

Thank you in advance

Quote from original request:-

"3. If after x minutes from “draft� email being sent the “final� has not
turned up can you set it so the system will send out an email to the email
in
“email� saying To [FROM]. You have sent an email [CONTENT] but this is
[VERSION]. Please send a revised version

4. Draft email and the new sent one then get moved to a UNMATCHED
inbox."


Code So Far...

Option Explicit

Private WithEvents olRecboxItems As Items

Private Sub Application_Startup()

Dim objNS As NameSpace
Dim DesFldr As MAPIFolder

Set objNS = Application.GetNamespace("MAPI")
' instantiate objects declared WithEvents
Set olRecboxItems = objNS.Folders("Mailbox - One, Some").Folders _
("Inbox").Folders("reconciliation").Items

Set objNS = Nothing
End Sub

Private Sub olRecboxItems_ItemAdd(ByVal Item As Object)

'Dim VerType As Integer
Dim NVersionType As String
Dim NWhoFrom As String
Dim NDateSent As String
Dim ExistItem As Variant
Dim ExVersionType As String
Dim ExWhoFrom As String
Dim ExDateSent As String
Dim MesgText As String
Dim objNS As NameSpace
Dim DesFldr As MAPIFolder

Set objNS = Application.GetNamespace("MAPI")
Set DesFldr = objNS.Folders("Mailbox - One, Some").Folders("Inbox") _
.Folders("reconciliation").Folders("Matched")
Set objNS = Nothing

'On Error Resume Next

'VerType = Item.Body Like "*Draft*" 'works with Case True/False

NVersionType = ParseTextLinePair(Item.Body, "Version:")
NWhoFrom = ParseTextLinePair(Item.Body, "From:")
‘NDateSent = ParseTextLinePair(Item.Body, "Date:")

Select Case NVersionType

Case Is = "Draft"
MsgBox NVersionType & " Test message(draft)"

Case Is = "Final"
MsgBox NVersionType & " Version - Sent by " & NWhoFrom & " on "
_
& NDateSent

If olRecboxItems.Count 1 Then
For Each ExistItem In olRecboxItems
'MsgBox ExistItem.Body
ExVersionType = ParseTextLinePair(ExistItem.Body,
"Version:")
ExWhoFrom = ParseTextLinePair(ExistItem.Body, "From:")
'ExDateSent = ParseTextLinePair(ExistItem.Body,
"Date:")

If ExVersionType = "Draft" And ExWhoFrom = NWhoFrom
Then
MsgBox ExistItem.Body & vbCr & vbCr & MesgText &
vbCr & _
vbCr & "Matched & Moved"
ExistItem.Move DesFldr
Item.Move DesFldr
Set Item = Nothing
Exit Sub
End If

Next
Else
MsgBox "No messages to compare Error"
Set Item = Nothing
Exit Sub
End If
MsgBox "No Matches"
Case Else
MsgBox "Unknown Version Error"

End Select

Set Item = Nothing
End Sub

Function ParseTextLinePair(strSource As String, strLabel As String)

Dim intLocLabel As Integer
Dim intLocCRLF As Integer
Dim intLenLabel As Integer
Dim strText As String

' locate the label in the source text
intLocLabel = InStr(strSource, strLabel)
intLenLabel = Len(strLabel)
If intLocLabel 0 Then
intLocCRLF = InStr(intLocLabel, strSource, vbCrLf)
If intLocCRLF 0 Then
intLocLabel = intLocLabel + intLenLabel
strText = Mid(strSource, _
intLocLabel, _
intLocCRLF - intLocLabel)
Else
strText = Mid(strSource, intLocLabel + intLenLabel)
End If
End If
ParseTextLinePair = Trim(strText)
End Functio



-----------------------------------------------------------------------------------------------------

Ken,

Thank you again for the reply..

I do not have VB 6 installed and this project does not otherwise use a
userform, I could look into calling Win32 API's - although I haven't done
this type of thing before. I have used system information before (usernames,
logon names) in VBA so I can probably find how to get the system time and I
would be able to use that.

I have been experimenting with .DeferredDeliveryTime but have had some flaky
results. At first I thought this was just due to the different 'time' on my
PC and the mail server, but I also managed to end up with deferred emails
that never sent.

I also have been seeing suggestions to use task reminders for triggers but
have not found an example yet.

Damon

"Ken Slovak - [MVP - Outlook]" wrote:

Neither Outlook nor VBA directly support a timer object. You can use a call
to a set of Win32 API's to set up a timer that way, you can add a 3rd party
timer control to a VBA UserForm or add the VB 6 timer control to a UserForm
if you have VB6 installed. You can also run code that checks the system time
and does something xx minutes after a certain time by storing the base time
in a user property in the item and checking that.

--
Ken Slovak
[MVP - Outlook]
http://www.slovaktech.com
Author: Absolute Beginner's Guide to Microsoft Office Outlook 2003
Reminder Manager, Extended Reminders, Attachment Options
http://www.slovaktech.com/products.htm


"Damon" wrote in message
news
Okay so using the ItemAdd example from the link provided by Ken, and
another
bit of example code from Sue Mosher for parsing data pairs (very useful!
see
'Function ParseTextLinePair' in 'code so far..' below), I have got quite
far..

The macro triggers upon receipt of an email in a particular folder, checks
for 'Draft' or 'Final' version and if 'Final' matches the email to the
'draft' version then moves both.

So next bit I am currently stuck on is how to reply to an email after x
minutes (Lets say 20 mins) if the 'final' version has not turned up to be
matched off. It seems that 'OnTime' is an excel only VBA function, does
Outlook have an equivalent? or is there another way I can do this?

Thank you in advance

Quote from original request:-

"3. If after x minutes from “draft� email being sent the “final� has not
turned up can you set it so the system will send out an email to the email
in
“email� saying To [FROM]. You have sent an email [CONTENT] but this is
[VERSION]. Please send a revised version

4. Draft email and the new sent one then get moved to a UNMATCHED
inbox."


Code So Far...

Option Explicit

Private WithEvents olRecboxItems As Items

Private Sub Application_Startup()

Dim objNS As NameSpace
Dim DesFldr As MAPIFolder

Set objNS = Application.GetNamespace("MAPI")
' instantiate objects declared WithEvents
Set olRecboxItems = objNS.Folders("Mailbox - One, Some").Folders _
("Inbox").Folders("reconciliation").Items

Set objNS = Nothing
End Sub

Private Sub olRecboxItems_ItemAdd(ByVal Item As Object)

'Dim VerType As Integer
Dim NVersionType As String
Dim NWhoFrom As String
Dim NDateSent As String
Dim ExistItem As Variant
Dim ExVersionType As String
Dim ExWhoFrom As String
Dim ExDateSent As String
Dim MesgText As String
Dim objNS As NameSpace
Dim DesFldr As MAPIFolder

Set objNS = Application.GetNamespace("MAPI")
Set DesFldr = objNS.Folders("Mailbox - One, Some").Folders("Inbox") _
.Folders("reconciliation").Folders("Matched")
Set objNS = Nothing

'On Error Resume Next

'VerType = Item.Body Like "*Draft*" 'works with Case True/False

NVersionType = ParseTextLinePair(Item.Body, "Version:")
NWhoFrom = ParseTextLinePair(Item.Body, "From:")
‘NDateSent = ParseTextLinePair(Item.Body, "Date:")

Select Case NVersionType

Case Is = "Draft"
MsgBox NVersionType & " Test message(draft)"

Case Is = "Final"
MsgBox NVersionType & " Version - Sent by " & NWhoFrom & " on "
_
& NDateSent

If olRecboxItems.Count 1 Then
For Each ExistItem In olRecboxItems
'MsgBox ExistItem.Body
ExVersionType = ParseTextLinePair(ExistItem.Body,
"Version:")
ExWhoFrom = ParseTextLinePair(ExistItem.Body, "From:")
'ExDateSent = ParseTextLinePair(ExistItem.Body,
"Date:")

If ExVersionType = "Draft" And ExWhoFrom = NWhoFrom
Then
MsgBox ExistItem.Body & vbCr & vbCr & MesgText &
vbCr & _
vbCr & "Matched & Moved"
ExistItem.Move DesFldr
Item.Move DesFldr
Set Item = Nothing
Exit Sub
End If

Next
Else
MsgBox "No messages to compare Error"
Set Item = Nothing
Exit Sub
End If
MsgBox "No Matches"
Case Else
MsgBox "Unknown Version Error"

End Select

Set Item = Nothing
End Sub

Function ParseTextLinePair(strSource As String, strLabel As String)

Dim intLocLabel As Integer
Dim intLocCRLF As Integer
Dim intLenLabel As Integer
Dim strText As String

' locate the label in the source text
intLocLabel = InStr(strSource, strLabel)
intLenLabel = Len(strLabel)
If intLocLabel 0 Then
intLocCRLF = InStr(intLocLabel, strSource, vbCrLf)
If intLocCRLF 0 Then
intLocLabel = intLocLabel + intLenLabel
strText = Mid(strSource, _
intLocLabel, _
intLocCRLF - intLocLabel)
Else
strText = Mid(strSource, intLocLabel + intLenLabel)
End If
End If
ParseTextLinePair = Trim(strText)
End Functio



-----------------------------------------------------------------------------------------------------