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