asked on

Deleting Items From a Public Folder using VB Script

Hi,

Bit of a weird one. I have written a basic script (below), which checks a public folder called 'Invoices Out' and deletes any older than 90 days.

Problem is, the script only seems to delete half of the items eligible for deletion. For example, the first time I ran it, it deleted 283 items out of 565. Next time I ran it, exactly the same script, it deleted 141, then 71, then 35, then 18, then 9. I now have 9 items left in, and I'm sure if it ran again, it would delete 4 or 5!

Am I missing something? The script actually only echoes the items it is actually deleting, so it looks like the 'If' statement is returning false for some reason (as opposed to the delete command failing). The sleep command I added to check if the speed of the loop was an issue but it didn't make any difference.

Any ideas?

dtmCutOff = DateAdd("d",-90,Date)
 
Set objOLK = CreateObject("Outlook.Application")
Set objNS = objOLK.Application.GetNamespace("MAPI")
Set objPF = objNS.Folders("Public Folders").Folders("All Public Folders").Folders("Invoices Out")
 
For Each objItem In objPF.Items
	If DateDiff("d",dtmCutOff,objItem.receivedTime) <= 0 Then 
		WScript.Echo "DELETING : " & objItem.subject & " " & objItem.receivedTime
		
		objItem.Delete
		intDeleted = intDeleted + 1
		WScript.Sleep 500
	End if
Next
 
WScript.Echo "Total " & intDeleted & " items deleted."
 
'Clean up
objOLK.Quit
Set objOLK = Nothing
Set objNS = Nothing
Set objPF = Nothing

Open in new window

karstieman

The problem is with de objitem.delete

explanation:
You loop through every OBJITEM in ObjPF.items.
But if you delete an item, the number of items in your ObjPF.items list gets smaller, so your next OBJITEM is 1 item too far.

bluntTony

You can take the delete command outside of the loop to avoid this issue. In the first loop, make a note of the unique ID of the item to delete (in this case into a dictionary object), then delete each item in the dictionary using the 'GetItemFromID' method MAPI namespace object.

I've re-worked the script below to do this. It's still a bit basic without any error trapping but the logic is there.

HTH

dtmCutOff = DateAdd("d",-90,Date)
 
Set objOLK = CreateObject("Outlook.Application")
Set objNS = objOLK.Application.GetNamespace("MAPI")
Set objPF = objNS.Folders("Public Folders").Folders("All Public Folders").Folders("Invoices Out")
Set objDict = CreateObject("Scripting.Dictionary")
 
For Each objItem In objPF.items
	If DateDiff("d",dtmCutOff,objItem.receivedTime) <= 0 Then
		intDeleted = intDeleted + 1
		objDict.Add objItem.entryID, objItem.subject & " " & objItem.receivedTime
	End if
Next
 
For Each dictKey In ObjDict.Keys
	WScript.Echo "DELETING : " & objDict.Item(dictKey)
	objNS.GetItemFromID(dictKey).Delete
Next
 
WScript.Echo "Total " & intDeleted & " items deleted."
 
'Clean up
objOLK.Quit
Set objOLK = Nothing
Set objNS = Nothing
Set objPF = Nothing
Set objDict = Nothing

Open in new window

ASKER CERTIFIED SOLUTION

bluntTony

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

gcz

ASKER

Thanks for the script. Just tested this and it works perfectly.

Many thanks.