Outlook pined while running macro

  • Thread starter Thread starter Guest
  • Start date Start date
G

Guest

Is there a way I can change my VBA code so that when it runs it does not
cripple Outlook. The VBA code iterativly goes through all folders in some
very large mailboxes and performs some tasks . Outlook becomes non-responsive.
 
Does Outlook ever come back or are you stuck in an endless loop? There are
ways to optimize your code but no one but you knows what your code is. Also,
using CDO 1.21 or Extended MAPI or Redemption RDO objects with Tables is
much faster than using the Outlook object model, by an order of magnitude at
least.

A typical scenario for iterating a folder's 15000 items might take a couple
of hours using the Outlook object model.
 
First of all, Thanks for the reply.

I am logging the output to a txt file and I can see my sctript is not stuck
in a loop. What I do see however is that the memory on the machine just keeps
going up until it esentially runs out. I'm closing all the objects but it
would appear that something is not releasing the memory. Is there a way to
see what object is taking up all the memory?

Here is the code, can you see where I have gone wrong?

There could be 15,000 items or more IPM.Note.Shortcut items in anyone of the
folders. I presume that may be my issue. Do you have any details or links on
using CDO instead?

'This is the mail function that all others are called from
'The code loops through all folders in the current profile looking for
'a specific IPM object over 45 days old and logs the information
Sub getFolders()
Dim myOlApp As Application
Dim myNameSpace As NameSpace
Dim myFolder As MAPIFolder
Dim myRoot As MAPIFolder

Set myOlApp = CreateObject("Outlook.Application")
Set myNameSpace = myOlApp.GetNamespace("MAPI")

Set myRoot = myNameSpace.GetDefaultFolder(olFolderInbox).Parent

ProcessFolder myRoot

Set myOlApp = Nothing
Set myNameSpace = Nothing
Set myRoot = Nothing
End Sub

Sub LogInformation(LogMessage As String)
Const LogFileName As String = "C:\out.txt"
Dim FileNum As Integer
FileNum = FreeFile ' next file number
Open LogFileName For Append As #FileNum ' creates the file if it doesn't
exist
Print #FileNum, LogMessage ' write information at the end of the text file
Close #FileNum ' close the file
End Sub

Sub ProcessFolder(StartFolder)
Dim objFolder As Outlook.MAPIFolder
Dim objItem As Object
Dim myItem As Object
Dim myItems As Object
Dim Days As Integer
Dim DelOlderThan As Date

Days = 45
DelOlderThan = Date - Days
deleteflag = 0

On Error Resume Next

' do something specific with this folder
Debug.Print StartFolder.FolderPath, StartFolder.Items.Count
Debug.Print

' process all the subfolders of this folder
For Each objFolder In StartFolder.Folders
'MsgBox objFolder
Call ProcessFolder(objFolder)
Next

Set myItems = StartFolder.Items
Set myItem = myItems.Find("[MessageClass] = 'IPM.Note.Shortcut'")

While Not myItem Is Nothing
If DelOlderThan > myItem.ReceivedTime Then
LogInformation myItem.Subject & "," & StartFolder.FolderPath &
"," & myItem.ReceivedTime
End If
Set myItem = myItems.FindNext
Wend

Set objFolder = Nothing
Set myItems = Nothing
Set myItem = Nothing

End Sub
 
Outlook opens internal variables while in a loop and doesn't release them
until the parent procedure is terminated. That can easily end up with out of
memory or resources problems.

For Each is more intensive than For i = type loops where you explicitly
instantiate the object. Setting objects = Nothing helps. So does minimizing
use of dot operators, which cause more internal variables to be opened:
instead of something like oFolder.Items.Item(1).Subject assign a separate
object for each dot operator. Using SetColumns on an Items collection
reduces the time and overhead of opening items. Calling a loop procedure 50
times to do 30 operations is better than calling it once for 1500
operations.

Those are typical optimizations.

For CDO see www.cdolive.com/cdo5.htm




Bob Smith said:
First of all, Thanks for the reply.

I am logging the output to a txt file and I can see my sctript is not
stuck
in a loop. What I do see however is that the memory on the machine just
keeps
going up until it esentially runs out. I'm closing all the objects but it
would appear that something is not releasing the memory. Is there a way to
see what object is taking up all the memory?

Here is the code, can you see where I have gone wrong?

There could be 15,000 items or more IPM.Note.Shortcut items in anyone of
the
folders. I presume that may be my issue. Do you have any details or links
on
using CDO instead?

'This is the mail function that all others are called from
'The code loops through all folders in the current profile looking for
'a specific IPM object over 45 days old and logs the information
Sub getFolders()
Dim myOlApp As Application
Dim myNameSpace As NameSpace
Dim myFolder As MAPIFolder
Dim myRoot As MAPIFolder

Set myOlApp = CreateObject("Outlook.Application")
Set myNameSpace = myOlApp.GetNamespace("MAPI")

Set myRoot = myNameSpace.GetDefaultFolder(olFolderInbox).Parent

ProcessFolder myRoot

Set myOlApp = Nothing
Set myNameSpace = Nothing
Set myRoot = Nothing
End Sub

Sub LogInformation(LogMessage As String)
Const LogFileName As String = "C:\out.txt"
Dim FileNum As Integer
FileNum = FreeFile ' next file number
Open LogFileName For Append As #FileNum ' creates the file if it
doesn't
exist
Print #FileNum, LogMessage ' write information at the end of the text
file
Close #FileNum ' close the file
End Sub

Sub ProcessFolder(StartFolder)
Dim objFolder As Outlook.MAPIFolder
Dim objItem As Object
Dim myItem As Object
Dim myItems As Object
Dim Days As Integer
Dim DelOlderThan As Date

Days = 45
DelOlderThan = Date - Days
deleteflag = 0

On Error Resume Next

' do something specific with this folder
Debug.Print StartFolder.FolderPath, StartFolder.Items.Count
Debug.Print

' process all the subfolders of this folder
For Each objFolder In StartFolder.Folders
'MsgBox objFolder
Call ProcessFolder(objFolder)
Next

Set myItems = StartFolder.Items
Set myItem = myItems.Find("[MessageClass] = 'IPM.Note.Shortcut'")

While Not myItem Is Nothing
If DelOlderThan > myItem.ReceivedTime Then
LogInformation myItem.Subject & "," & StartFolder.FolderPath &
"," & myItem.ReceivedTime
End If
Set myItem = myItems.FindNext
Wend

Set objFolder = Nothing
Set myItems = Nothing
Set myItem = Nothing

End Sub
Click to expand...
 
First of all, thanks for the reply.

For the most part, I understand what you mean. What I don't know however is
how to modify my script to be more efficient without looping through every
mail message. I thought that using

myItems.Find("[MessageClass] = 'IPM.Note.Shortcut'")

rather than

for X = 1 to StartFolder.Items.Count
If Myitems.MessageClass = 'IPM.Note.Shortcut' then
... Perform Action
End if
x = x + 1
next

Would be more efficient because I'm not checking every mail item, just the
ones returned from the find.

Also, do you have a suggestion of how to iterativley go through each folder
without needing to use "for each objfolder". Do I need to collaps the array
returned by the statement myNameSpace.GetDefaultFolder(olFolderInbox).Parent.


Thanks once again for your help. Any hints on where to go from here would be
apreciated.

Ken Slovak - said:
Outlook opens internal variables while in a loop and doesn't release them
until the parent procedure is terminated. That can easily end up with out of
memory or resources problems.

For Each is more intensive than For i = type loops where you explicitly
instantiate the object. Setting objects = Nothing helps. So does minimizing
use of dot operators, which cause more internal variables to be opened:
instead of something like oFolder.Items.Item(1).Subject assign a separate
object for each dot operator. Using SetColumns on an Items collection
reduces the time and overhead of opening items. Calling a loop procedure 50
times to do 30 operations is better than calling it once for 1500
operations.

Those are typical optimizations.

For CDO see www.cdolive.com/cdo5.htm




Bob Smith said:
First of all, Thanks for the reply.

I am logging the output to a txt file and I can see my sctript is not
stuck
in a loop. What I do see however is that the memory on the machine just
keeps
going up until it esentially runs out. I'm closing all the objects but it
would appear that something is not releasing the memory. Is there a way to
see what object is taking up all the memory?

Here is the code, can you see where I have gone wrong?

There could be 15,000 items or more IPM.Note.Shortcut items in anyone of
the
folders. I presume that may be my issue. Do you have any details or links
on
using CDO instead?

'This is the mail function that all others are called from
'The code loops through all folders in the current profile looking for
'a specific IPM object over 45 days old and logs the information
Sub getFolders()
Dim myOlApp As Application
Dim myNameSpace As NameSpace
Dim myFolder As MAPIFolder
Dim myRoot As MAPIFolder

Set myOlApp = CreateObject("Outlook.Application")
Set myNameSpace = myOlApp.GetNamespace("MAPI")

Set myRoot = myNameSpace.GetDefaultFolder(olFolderInbox).Parent

ProcessFolder myRoot

Set myOlApp = Nothing
Set myNameSpace = Nothing
Set myRoot = Nothing
End Sub

Sub LogInformation(LogMessage As String)
Const LogFileName As String = "C:\out.txt"
Dim FileNum As Integer
FileNum = FreeFile ' next file number
Open LogFileName For Append As #FileNum ' creates the file if it
doesn't
exist
Print #FileNum, LogMessage ' write information at the end of the text
file
Close #FileNum ' close the file
End Sub

Sub ProcessFolder(StartFolder)
Dim objFolder As Outlook.MAPIFolder
Dim objItem As Object
Dim myItem As Object
Dim myItems As Object
Dim Days As Integer
Dim DelOlderThan As Date

Days = 45
DelOlderThan = Date - Days
deleteflag = 0

On Error Resume Next

' do something specific with this folder
Debug.Print StartFolder.FolderPath, StartFolder.Items.Count
Debug.Print

' process all the subfolders of this folder
For Each objFolder In StartFolder.Folders
'MsgBox objFolder
Call ProcessFolder(objFolder)
Next

Set myItems = StartFolder.Items
Set myItem = myItems.Find("[MessageClass] = 'IPM.Note.Shortcut'")

While Not myItem Is Nothing
If DelOlderThan > myItem.ReceivedTime Then
LogInformation myItem.Subject & "," & StartFolder.FolderPath &
"," & myItem.ReceivedTime
End If
Set myItem = myItems.FindNext
Wend

Set objFolder = Nothing
Set myItems = Nothing
Set myItem = Nothing

End Sub
Click to expand...
Click to expand...
 
Find is more efficient than just looping through every item in the folder,
yes. I usually use a Restriction clause myself and then loop the returned
restricted Items collection. But using a filtered MAPITable in Extended MAPI
or Redemption is even more efficient, although read-only. Looping a
collection, filtered or otherwise, in CDO 1.21 is also more efficient and
faster than using the Outlook object model.

Again, in terms of resources although not speed, using a For 1 = to
Folders.Count would be more efficient than using a For Each loop there.
 
Back
Top