Tom Becker wrote:
On 9 Mar 2006 11:39:45 -0800, CD********@FortuneJames.com wrote:
I've got the code. I'll have to pare it down to the essentials for
you. I think I monitored the activity of certain critical folders and
waited until there was no activity for a certain amount of time before
closing Outlook.
Thanks much. I would like to have that.
Here is the code you requested. Note that it is quite old and may not
utilize best practices:
'Code within some subroutine
'Initialize delay, inactivity, outbox time limit and their time window
values
intExpireMinutes = 1
lngITolerSec = 45
intInitialDelayMin = 1
lngInitialDelayTolerSec = 5
intOutLimit = 5
lngOutLimitTolerSec = 5
intOExpireMinutes = 1
lngOTolerSec = 45
'-------------------------------------------------------
'Set up Date and Time for time stamp fields
varImportDate = Format(Now, "m/d/yyyy")
varImportTime = Format(Now, "hh:nn:ss")
strToday = Format$(varImportDate, "mm/dd/yy")
'-------------------------------------------------------
'Extra information for log file
strExtra = ""
'...
'Wait intInnitialDelayMin minutes before checking for any activity
GoSub InitDelay
'-------------------------------------------------------
'Checking these folders for inactivity
Set objNameSpace = objOutlook.GetNamespace("MAPI")
'Set objTCOrders = objNameSpace.Folders.Item("Personal
Folders").Folders.Item("TCOrders")
Set objOrderReceived = objNameSpace.Folders.Item("Personal
Folders").Folders.Item("OrderReceived")
Set objOrderShipped = objNameSpace.Folders.Item("Personal
Folders").Folders.Item("OrderShipped")
Set objBackOrdered = objNameSpace.Folders.Item("Personal
Folders").Folders.Item("BackOrdered")
'Set objItems = objTCOrders.Items
Set objBackOrderedItems = objBackOrdered.Items
Set objOrderShippedItems = objOrderShipped.Items
Set objOrderReceivedItems = objOrderReceived.Items
'Don't release the objects yet. They're needed for the processing step
'-------------------------------------------------------
'Now watch the folders to determine when Outlook is done downloading
GoSub Activity
'-------------------------------------------------------
strTemp = "Done"
lblWorking.Caption = strTemp
lblStatus.Caption = "Downloading Email"
DoEvents
cmdDownloadEmail.ForeColor = RGB(255, 60, 0)
Exit Sub
'-------------------------------------------------------
'GoSub Subroutines
Activity:
'Now watch the folder to determine when Outlook is done downloading
'Start the timer
'Set the expire time to intExpireMinutes minutes in the future
varTimerExpire = DateAdd("n", intExpireMinutes, Now())
'''''intOrderItems = objItems.Count
intBackOrderedItems = objBackOrderedItems.Count
intOrderShippedItems = objOrderShippedItems.Count
intOrderReceivedItems = objOrderReceivedItems.Count
boolDone = False
strLastActivity = ""
Do While Not boolDone
DoEvents
'boolTemp = (objItems.Count = intOrderItems)
'If Not boolTemp Then strActiveIn = "TCOrders"
'boolSame = boolTemp
boolSame = True
boolTemp = (objBackOrderedItems.Count = intBackOrderedItems)
If Not boolTemp Then strActiveIn = "BackOrdered"
boolSame = boolSame And boolTemp
boolTemp = (objOrderShippedItems.Count = intOrderShippedItems)
If Not boolTemp Then strActiveIn = "OrderShipped"
boolSame = boolSame And boolTemp
boolTemp = (objOrderReceivedItems.Count = intOrderReceivedItems)
If Not boolTemp Then strActiveIn = "OrderReceived"
boolSame = boolSame And boolTemp
If boolSame Then
'Keep checking the timer
'If the current time is within lngITolerSec seconds of the Expire
Time, exit
strTemp = strLastActivity
If strTemp <> "" Then
lblWorking.Caption = strTemp
lblStatus.Caption = "Time of last activity"
DoEvents
End If
If Abs(DateDiff("s", Now(), varTimerExpire)) < lngITolerSec Then
boolDone = True
Else
strLastActivity = "Time: " & Format$(Now(), "hh:nn:ss ampm") & " "
& strActiveIn
'Reset the timer
varTimerExpire = DateAdd("n", intExpireMinutes, Now())
'Reset intOrderItems
'intOrderItems = objItems.Count
intBackOrderedItems = objBackOrderedItems.Count
intOrderShippedItems = objOrderShippedItems.Count
intOrderReceivedItems = objOrderReceivedItems.Count
strTemp = "Activity" & CStr(objItems.Count)
lblWorking.Caption = strTemp
lblStatus.Caption = "Checking inactivity"
DoEvents
End If
Loop
'At this point, there was no activity in four folders for specified
time.
Return
'-------------------------------------------------------
SendRecv:
Set MyExplorer = Nothing
Set MyExplorer = objOutlook.ActiveExplorer
MyExplorer.Activate
MyExplorer.WindowState = olMaximized
Set MyMenuBar = MyExplorer.CommandBars.Item("Standard")
Set MyMenuBarControl = MyMenuBar.Controls.Item("Send/Re&ceive")
MyMenuBarControl.Execute
Set MyMenuBar = Nothing
Return
'-------------------------------------------------------
InitDelay:
strTemp = "Waiting " & intInitialDelayMin & " min..."
lblWorking.Caption = strTemp
lblStatus.Caption = "Initial Delay"
DoEvents
varTimerExpire = DateAdd("n", intInitialDelayMin, Now())
Do While Not boolDone
DoEvents
If Abs(DateDiff("s", Now(), varTimerExpire)) <
lngInitialDelayTolerSec Then boolDone = True
Loop
strTemp = "Timing..."
lblWorking.Caption = strTemp
lblStatus.Caption = "Checking inactivity"
DoEvents
Return
'Another code snippet:
'Close Outlook 2000
'First wait until the outbox is empty
'Then wait for the Outbox count to go to zero
'!Also need a fail-safe in case emails are not sent
'When first of Time Limit, Outbox count = 0 happens, continue
varTimerExpire = DateAdd("n", intOutLimit, Now())
boolDone = False
Set objOutbox = objNameSpace.Folders.Item("Personal
Folders").Folders.Item("Outbox")
Set objOutboxItems = objOutbox.Items
intOutboxCount = objOutboxItems.Count
If intOutboxCount > 0 Then
'Click the Send/Receive button again
GoSub SendRecv
'Minimize Outlook so the user can see the activity
MyExplorer.WindowState = olMinimized
'look for activity in outbox
'Start the timer
'Set the expire time to intOExpireMinutes minutes in the future
varTimerExpire = DateAdd("n", intOExpireMinutes, Now())
intOutboxItems = objOutboxItems.Count
boolDone = False
strLastActivity = ""
strActiveIn = "Outbox"
Do While Not boolDone
DoEvents
boolTemp = (objOutboxItems.Count = intOutboxItems)
boolSame = boolTemp
If boolSame Then
'Keep checking the timer
'If the current time is within lngOTolerSec seconds of the Expire
Time, exit
strTemp = strLastActivity
If strTemp <> "" Then
lblWorking.Caption = strTemp
lblStatus.Caption = "Time of last Outbox activity"
DoEvents
End If
If Abs(DateDiff("s", Now(), varTimerExpire)) < lngOTolerSec Then
boolDone = True
Else
strLastActivity = "Time: " & Format$(Now(), "hh:nn:ss ampm") & "
" & strActiveIn
'Reset the timer
varTimerExpire = DateAdd("n", intOExpireMinutes, Now())
intOutboxItems = objOutbox.Items.Count
strTemp = "Activity " & CStr(objOutboxItems.Count)
lblWorking.Caption = strTemp
lblStatus.Caption = "Checking Outbox inactivity"
DoEvents
End If
Loop
'At this point, there was no activity in the outbox for specified
time
End If
James A. Fortune
CD********@FortuneJames.com