U
Uri Inbar
Hello,
We're using Exchange2000 (SP3) with Outlook2002.
I've recently began running a VB program that runs once every hour, scans
all of the calendars in our organization doing all sorts of checkings and
altering some appointments, and finally closes down (running time is around
10 minutes).
The problem is that after each run of this program, the 'Microsoft Exchange
Information Store' service (STORE.EXE) on the Exchange Server seems to take
more and more memory without releasing it back. The situation gets so bad
that I need to restart the information-store service every few hours in
order to free the leaked memory.
Following is an example of a process such as the one I'm running (this one
is simpler and causing the same problem).
Any help or suggestion would be greatly appreciated!
Thanks,
Uri.
----------------------------------------------------------------------------
-------------------------------------------------------
' Make tentative appointments appear in the free/busy time without needing
the users to open their Outlook/Inbox items
Public Sub SyncAllInboxFolders(ByRef OlApp As Outlook.Application)
Dim rcpColl As Collection
Dim rcp As Outlook.Recipient
Dim userInboxFolder As Outlook.mapiFolder
On Error GoTo errTrap
Set myOlApp = OlApp
Set myNameSpace = OlApp.GetNamespace("MAPI")
' Get recipients collection of recipients that need to be handled
Set rcpColl = getRecipientsCollection()
If rcpColl Is Nothing Then
GoTo finish
End If
On Error Resume Next
For Each rcp In rcpColl
Err.Number = 0
' Being an Administrator - we can get the user's inbox folder and
see if new appointment related messages are preset
Set userInboxFolder = myNameSpace.GetSharedDefaultFolder(rcp,
olFolderInbox)
If Err.Number = 0 Then
' Make sure the user's calendar is up to date with the Inbox
related items
Call syncTentativeInbox(userInboxFolder)
End If
Set userInboxFolder = Nothing
Set rcp = Nothing
DoEvents
Next
GoTo finish
errTrap:
Logger_Add "*** ERROR " & Err.Number & " in SyncAllInboxFolders(...): "
& Err.Description
finish:
myNameSpace.Logoff
Set rcp = Nothing
Set rcpColl = Nothing
Set myNameSpace = Nothing
Set myOlApp = Nothing
End Sub
Public Sub syncTentativeInbox(ByRef userInboxFolder As Outlook.mapiFolder)
Dim meetingItem As Object 'Outlook.MailItem
Dim apptItem As Object
Dim inboxItems As Outlook.Items
Dim myFolder As mapiFolder
Set myFolder = userInboxFolder
On Error GoTo skip
If myFolder.UnReadItemCount > 0 Then
Set inboxItems = myFolder.Items
inboxItems.Sort "[Received]"
On Error GoTo skip
For Each meetingItem In inboxItems
If meetingItem.Unread = True Then
If meetingItem.MessageClass Like "IPM.Schedule.*" Then
If Not meetingItem.Categories Like "*" +
updatedInCalendarSTR + "*" Then
meetingItem.Categories = meetingItem.Categories +
IIf(Len(Trim(meetingItem.Categories)) > 0, ",", "") + updatedInCalendarSTR
meetingItem.Save
On Error Resume Next
Err.Number = 0
' Do the actual marking in the Calendar
Set apptItem =
meetingItem.GetAssociatedAppointment(True)
End If
Set apptItem = Nothing
End If
End If
skip:
Set meetingItem = Nothing
DoEvents
Next
End If
On Error GoTo 0
Set meetingItem = Nothing
Set inboxItems = Nothing
Set myFolder = Nothing
End Sub
We're using Exchange2000 (SP3) with Outlook2002.
I've recently began running a VB program that runs once every hour, scans
all of the calendars in our organization doing all sorts of checkings and
altering some appointments, and finally closes down (running time is around
10 minutes).
The problem is that after each run of this program, the 'Microsoft Exchange
Information Store' service (STORE.EXE) on the Exchange Server seems to take
more and more memory without releasing it back. The situation gets so bad
that I need to restart the information-store service every few hours in
order to free the leaked memory.
Following is an example of a process such as the one I'm running (this one
is simpler and causing the same problem).
Any help or suggestion would be greatly appreciated!
Thanks,
Uri.
----------------------------------------------------------------------------
-------------------------------------------------------
' Make tentative appointments appear in the free/busy time without needing
the users to open their Outlook/Inbox items
Public Sub SyncAllInboxFolders(ByRef OlApp As Outlook.Application)
Dim rcpColl As Collection
Dim rcp As Outlook.Recipient
Dim userInboxFolder As Outlook.mapiFolder
On Error GoTo errTrap
Set myOlApp = OlApp
Set myNameSpace = OlApp.GetNamespace("MAPI")
' Get recipients collection of recipients that need to be handled
Set rcpColl = getRecipientsCollection()
If rcpColl Is Nothing Then
GoTo finish
End If
On Error Resume Next
For Each rcp In rcpColl
Err.Number = 0
' Being an Administrator - we can get the user's inbox folder and
see if new appointment related messages are preset
Set userInboxFolder = myNameSpace.GetSharedDefaultFolder(rcp,
olFolderInbox)
If Err.Number = 0 Then
' Make sure the user's calendar is up to date with the Inbox
related items
Call syncTentativeInbox(userInboxFolder)
End If
Set userInboxFolder = Nothing
Set rcp = Nothing
DoEvents
Next
GoTo finish
errTrap:
Logger_Add "*** ERROR " & Err.Number & " in SyncAllInboxFolders(...): "
& Err.Description
finish:
myNameSpace.Logoff
Set rcp = Nothing
Set rcpColl = Nothing
Set myNameSpace = Nothing
Set myOlApp = Nothing
End Sub
Public Sub syncTentativeInbox(ByRef userInboxFolder As Outlook.mapiFolder)
Dim meetingItem As Object 'Outlook.MailItem
Dim apptItem As Object
Dim inboxItems As Outlook.Items
Dim myFolder As mapiFolder
Set myFolder = userInboxFolder
On Error GoTo skip
If myFolder.UnReadItemCount > 0 Then
Set inboxItems = myFolder.Items
inboxItems.Sort "[Received]"
On Error GoTo skip
For Each meetingItem In inboxItems
If meetingItem.Unread = True Then
If meetingItem.MessageClass Like "IPM.Schedule.*" Then
If Not meetingItem.Categories Like "*" +
updatedInCalendarSTR + "*" Then
meetingItem.Categories = meetingItem.Categories +
IIf(Len(Trim(meetingItem.Categories)) > 0, ",", "") + updatedInCalendarSTR
meetingItem.Save
On Error Resume Next
Err.Number = 0
' Do the actual marking in the Calendar
Set apptItem =
meetingItem.GetAssociatedAppointment(True)
End If
Set apptItem = Nothing
End If
End If
skip:
Set meetingItem = Nothing
DoEvents
Next
End If
On Error GoTo 0
Set meetingItem = Nothing
Set inboxItems = Nothing
Set myFolder = Nothing
End Sub