A Microsoft Outlook email forum. Outlook Banter

If this is your first visit, be sure to check out the FAQ by clicking the link above. You may have to register before you can post: click the register link above to proceed. To start viewing messages, select the forum that you want to visit from the selection below.

Go Back   Home » Outlook Banter forum » Microsoft Outlook Email Newsgroups » Outlook and VBA
Site Map Home Register Authors List Search Today's Posts Mark Forums Read Web Partners

Anyone up for a challenge?



 
 
Thread Tools Search this Thread Display Modes
  #1  
Old March 1st 07, 05:21 PM posted to microsoft.public.outlook.program_vba
Damon
external usenet poster
 
Posts: 14
Default Anyone up for a challenge?

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]" wrote:

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.

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



  #2  
Old March 1st 07, 05:48 PM posted to microsoft.public.outlook.program_vba
Ken Slovak - [MVP - Outlook]
external usenet poster
 
Posts: 5,848
Default Anyone up for a challenge?

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 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
...
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 ;-) )


 




Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts

vB code is On
Smilies are On
[IMG] code is On
HTML code is Off
Forum Jump

Similar Threads
Thread Thread Starter Forum Replies Last Post
Challenge with Oiutlook 2003 Archive jjjoseph Outlook - General Queries 1 January 15th 07 11:15 PM
I challenge anyone to answer this one.................Do you dare? Challenger Outlook - Installation 4 May 3rd 06 06:59 PM
Here's a challenge - VBA regarding mail Stealth1 Outlook and VBA 3 April 26th 06 06:03 PM
A difficult VBA question...a challenge Stealth1 Outlook - General Queries 2 April 25th 06 10:28 PM
Spamming Challenge! [email protected] Outlook - General Queries 4 April 25th 06 03:08 PM


All times are GMT +1. The time now is 09:12 AM.


Powered by vBulletin® Version 3.6.4
Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.Search Engine Friendly URLs by vBSEO 2.4.0
Copyright ©2004-2025 Outlook Banter.
The comments are property of their posters.