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



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