Anyone up for a challenge?

[Guest]

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: (e-mail address removed)
Date: 03/02/2007 08:38
Content: Please find attached draft file for the rec

Second email:
Code: RECS
From: US11283
Version: Final
Email: (e-mail address removed)
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 Slovak - [MVP - Outlook]]

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.

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: (e-mail address removed)
Date: 03/02/2007 08:38
Content: Please find attached draft file for the rec

Second email:
Code: RECS
From: US11283
Version: Final
Email: (e-mail address removed)
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

 

[Guest]

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

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.

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: (e-mail address removed)
Date: 03/02/2007 08:38
Content: Please find attached draft file for the rec

Second email:
Code: RECS
From: US11283
Version: Final
Email: (e-mail address removed)
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

 

[Guest]

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,

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

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.

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: (e-mail address removed)
Date: 03/02/2007 08:38
Content: Please find attached draft file for the rec

Second email:
Code: RECS
From: US11283
Version: Final
Email: (e-mail address removed)
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 Slovak - [MVP - Outlook]]

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.

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



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

 

[Guest]

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

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.

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 Slovak - [MVP - Outlook]]

Well, those are the ways I know of to do a timer sort of thing.

You could I suppose set task reminders but those might not have the
granularity you might need. You can only use a granularity of 1 minute. You
would the have to catch the reminder firing and cancel the display of the
reminder plus dismissing it and then deleting the task so the user won't see
it. It might take some experimentation to try to get the reminder canceled
without showing it or playing a reminder sound, although that can be
disabled when you set the reminder.

 

[Guest]

Ken,

After reading your reply I started looking into the other suggestions you
made and I found the following example of using an API timer in VBA (it's
from C. Pearsons very helpful site for excel VBA tips.)
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Declare Function SetTimer Lib "user32" ( _
ByVal HWnd As Long, ByVal nIDEvent As Long, _
ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Public Declare Function KillTimer Lib "user32" ( _
ByVal HWnd As Long, ByVal nIDEvent As Long) As Long

Public TimerID As Long
Public TimerSeconds As Single

Sub StartTimer()
TimerSeconds = 20 ' how often to "pop" the timer.
TimerID = SetTimer(0&, 0&, TimerSeconds * 1000&, AddressOf TimerProc)
End Sub

Sub EndTimer()
On Error Resume Next
KillTimer 0&, TimerID
End Sub

Sub TimerProc(ByVal HWnd As Long, ByVal uMsg As Long, _
ByVal nIDEvent As Long, ByVal dwTimer As Long)
'
' The procedure is called by Windows. Put your
' timer-related code here.
'
MsgBox "timed event" '<------------------ I added this line
End Sub
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
This seemed to work great until I decided to test what would happen if the
timer was started multiple times. I was pleased to see that the message I
had triggering every 20 seconds started triggering multiple times in a 20
seconds period, However it then didn't matter how many times I ran the
EndTimer sub the TimerProc sub kept running, even if Outlook was closed (only
managed to stop it by deleting TimerProc sub from the module and letting
Outlook crash)
Would a 3rd party timer in a userform be likely to have a similar issue or
not?

[Pre Posting Edit--- reading back this text before posting, it has occurred
to me that the issue above may be caused because TimerID is the same for each
case? If so how could I vary it without varying the TimerSeconds?]

So it seems I'm back to task items with reminders for the moment as I can
have multiple 'timers' set at once.

As the timer is just to send a reminder email it doesn't really need to be
at a precise time just approximately 20mins after first email if second is
not received yet. Not sure if that is what you meant by 'granularity of 1
minute'...

This bit of code...
''''''''
Private Sub Application_Reminder(ByVal Item As Object)
If Item.Subject = "Auto Recs Reminder" Then
'<------------------My code here--------------->
Item.Delete
End If
End Sub
''''''''
Does prevent the Reminder from showing (although you do notice it try to
show) and does, to my mild surprise, delete the TaskItem (I thought it might
just delete the reminder attached to the task.) It does beep though so I will
have to disable the sound when setting the reminder as you suggest.

Again thank you Ken for all your help, before your first reply I did not
even have a clue how to get started with Outlook programming (apart from
coming here to ask ;-) )

 

[Ken Slovak - [MVP - Outlook]]

I usually use an API timer this way. I haven't done it specifically in VBA
code, it's usually in VB 6 code, but they should be identical or almost
identical:

First, a CTimer class. Then a basTimer code module, finally code to init and
destroy the timer:

'************************************************************
' CTimer class
'************************************************************

Option Explicit

'************************************************************
' Slovak Technical Services, Inc.
'************************************************************

Private iInterval As Long
Private ID As Long

' User can attach any Variant data they want to the timer
Public Item As Variant

Public Event ThatTime()

' SubTimer is independent of VBCore, so it hard codes error handling

Public Enum EErrorTimer
eeBaseTimer = 13650 ' CTimer
eeTooManyTimers ' No more than 10 timers allowed per class
eeCantCreateTimer ' Can't create system timer
End Enum

Friend Sub ErrRaise(e As Long)
Dim sText As String
Dim sSource As String

If e > 1000 Then
sSource = App.EXEName & ".WindowProc"
Select Case e
Case eeTooManyTimers
sText = "No more than 10 timers allowed per class"
Case eeCantCreateTimer
sText = "Can't create system timer"
End Select
Err.Raise e Or vbObjectError, sSource, sText
Else
' Raise standard Visual Basic error
Err.Raise e, sSource
End If
End Sub

Property Get Interval() As Long
Interval = iInterval
End Property

' Can't just change interval--you must kill timer and start a new one
Property Let Interval(iIntervalA As Long)
Dim f As Boolean

If iIntervalA > 0 Then
' Don't mess with it if interval is the same
If iInterval = iIntervalA Then Exit Property
' Must destroy any existing timer to change interval
If iInterval Then
f = TimerDestroy(Me)
Debug.Assert f ' Shouldn't fail
End If
' Create new timer with new interval
iInterval = iIntervalA
If TimerCreate(Me) = False Then ErrRaise eeCantCreateTimer
Else
If (iInterval > 0) Then
iInterval = 0
f = TimerDestroy(Me)
Debug.Assert f ' Shouldn't fail
End If
End If
End Property

' Must be public so that Timer object can't terminate while client's
ThatTime
' event is being processed--Friend wouldn't prevent this disaster
Public Sub PulseTimer()
RaiseEvent ThatTime
End Sub

Friend Property Get TimerID() As Long
TimerID = ID
End Property

Friend Property Let TimerID(idA As Long)
ID = idA
End Property

Private Sub Class_Terminate()
Interval = 0
End Sub

'************************************************************
' End CTimer class
'************************************************************

'************************************************************
' basTimer code module
'************************************************************

Option Explicit

'************************************************************
' Slovak Technical Services, Inc.
'************************************************************

' declares:
Private Declare Function SetTimer Lib "user32" (ByVal hWnd As Long, ByVal
nIdEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Private Declare Function KillTimer Lib "user32" (ByVal hWnd As Long, ByVal
nIdEvent As Long) As Long

Private Const cTimerMax = 100

' Array of timers
Public aTimers(1 To cTimerMax) As CTimer

' Added SPM to prevent excessive searching through aTimers array:
Private m_cTimerCount As Integer

Public Function TimerCreate(timer As CTimer) As Boolean
Dim i As Integer

On Error Resume Next

'Create the timer
timer.TimerID = SetTimer(0&, 0&, timer.Interval, AddressOf TimerProc)
If timer.TimerID Then
TimerCreate = True
For i = 1 To cTimerMax
If (aTimers(i) Is Nothing) Then
Set aTimers(i) = timer
If (i > m_cTimerCount) Then
m_cTimerCount = i
End If

TimerCreate = True

Exit Function
End If
Next
timer.ErrRaise eeTooManyTimers
Else
timer.TimerID = 0
timer.Interval = 0
End If

Err.Clear
End Function

Public Function TimerDestroy(timer As CTimer) As Long
Dim i As Integer
Dim f As Boolean

On Error Resume Next

' Find and remove this timer
' SPM - no need to count past the last timer set up in the
' aTimer array:
For i = 1 To m_cTimerCount
' Find timer in array
If Not (aTimers(i) Is Nothing) Then
If timer.TimerID = aTimers(i).TimerID Then
f = KillTimer(0, timer.TimerID)
' Remove timer and set reference to nothing
Set aTimers(i) = Nothing

TimerDestroy = True

Exit Function
End If
End If
Next

Err.Clear
End Function

Public Sub TimerProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal IDEvent
As Long, ByVal dwTime As Long)
Dim i As Integer

On Error Resume Next

' Find the timer with this ID
For i = 1 To m_cTimerCount
' SPM: Add a check to ensure aTimers(i) is not nothing!
' This would occur if we had two timers declared from
' the same thread and we terminated the first one before
' the second! Causes serious GPF if we don't do this...
If Not (aTimers(i) Is Nothing) Then
If IDEvent = aTimers(i).TimerID Then
' Generate the event
aTimers(i).PulseTimer

Exit Sub
End If
End If
Next

Err.Clear
End Sub

Private Function StoreTimer(timer As CTimer)
Dim i As Integer

On Error Resume Next

For i = 1 To m_cTimerCount
If aTimers(i) Is Nothing Then
Set aTimers(i) = timer

StoreTimer = True

Exit Function
End If
Next

Err.Clear
End Function

'************************************************************
' End basTimer code module
'************************************************************

'************************************************************
' Code to call and release a timer (in a class module to handle events)
'************************************************************

Private WithEvents m_oTimer As CTimer

'******************* init timer
Set m_oTimer = New CTimer
m_oTimer.Interval = 500 ' 500 ms (1/2 minute)

'******************* timer event handler
Private Sub m_oTimer_ThatTime()
On Error Resume Next

m_oTimer.Interval = 0

' do something here

' reset timer to restart by m_oTimer.Interval = 500 for every 1/2 minute
again
End Sub

'******************** kill timer
If Not (m_oTimer Is Nothing) Then
m_oTimer.Interval = 0
Set m_oTimer = Nothing
End If

Ken,

After reading your reply I started looking into the other suggestions you
made and I found the following example of using an API timer in VBA (it's
from C. Pearsons very helpful site for excel VBA tips.)
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Declare Function SetTimer Lib "user32" ( _
ByVal HWnd As Long, ByVal nIDEvent As Long, _
ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Public Declare Function KillTimer Lib "user32" ( _
ByVal HWnd As Long, ByVal nIDEvent As Long) As Long

Public TimerID As Long
Public TimerSeconds As Single

Sub StartTimer()
TimerSeconds = 20 ' how often to "pop" the timer.
TimerID = SetTimer(0&, 0&, TimerSeconds * 1000&, AddressOf TimerProc)
End Sub

Sub EndTimer()
On Error Resume Next
KillTimer 0&, TimerID
End Sub

Sub TimerProc(ByVal HWnd As Long, ByVal uMsg As Long, _
ByVal nIDEvent As Long, ByVal dwTimer As Long)
'
' The procedure is called by Windows. Put your
' timer-related code here.
'
MsgBox "timed event" '<------------------ I added this line
End Sub
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
This seemed to work great until I decided to test what would happen if the
timer was started multiple times. I was pleased to see that the message I
had triggering every 20 seconds started triggering multiple times in a 20
seconds period, However it then didn't matter how many times I ran the
EndTimer sub the TimerProc sub kept running, even if Outlook was closed
(only
managed to stop it by deleting TimerProc sub from the module and letting
Outlook crash)
Would a 3rd party timer in a userform be likely to have a similar issue or
not?

[Pre Posting Edit--- reading back this text before posting, it has
occurred
to me that the issue above may be caused because TimerID is the same for
each
case? If so how could I vary it without varying the TimerSeconds?]

So it seems I'm back to task items with reminders for the moment as I can
have multiple 'timers' set at once.

As the timer is just to send a reminder email it doesn't really need to be
at a precise time just approximately 20mins after first email if second is
not received yet. Not sure if that is what you meant by 'granularity of 1
minute'...

This bit of code...
''''''''
Private Sub Application_Reminder(ByVal Item As Object)
If Item.Subject = "Auto Recs Reminder" Then
'<------------------My code here--------------->
Item.Delete
End If
End Sub
''''''''
Does prevent the Reminder from showing (although you do notice it try to
show) and does, to my mild surprise, delete the TaskItem (I thought it
might
just delete the reminder attached to the task.) It does beep though so I
will
have to disable the sound when setting the reminder as you suggest.

Again thank you Ken for all your help, before your first reply I did not
even have a clue how to get started with Outlook programming (apart from
coming here to ask ;-) )