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
-----------------------------------------------------------------------------------------------------