![]() |
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. |
|
|
Thread Tools | Search this Thread | Display Modes |
|
#1
|
|||
|
|||
![]()
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
|
|||
|
|||
![]()
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 |
Display Modes | |
|
|
![]() |
||||
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 |