Permanent Delete

[batesharold]

Two questions please:

1. I have CDO enabled in Outlook 2000 SR-1, yet the code below fails
saying user defined type not defined highlight the code "
Dim objSession As New MAPI.Session"

2. How can I modify below to select a specific folder (sent items)
instead of active folder.


To do this with code, you need to use CDO. This macro will permanently
delete the currently selected items:

Sub PermanentlyDeleteSelectedMessges()
On Error GoTo PermanentlyDeleteSelectedMessges_Error

Dim objSession As New MAPI.Session
Dim objSelection As Outlook.Selection
Dim objItem As Object
Dim objMAPIMessage As MAPI.Message 'Requires reference to the
Microsoft
CDO 1.21 Library

'To permanently delete currently selected item(s) in active folder
objSession.Logon , , , False
Set objSelection = ActiveExplorer.Selection

If objSelection Is Nothing Or objSelection.Count = 0 Then Exit Sub
For Each objItem In objSelection
Set objMAPIMessage = objSession.GetMessage(objItem.EntryID)
'Permanently delete
objMAPIMessage.Delete False
Next

Leave:
If Not objSession Is Nothing Then objSession.Logoff
Set objSession = Nothing
Set objSelection = Nothing
Set objItem = Nothing
Set objMAPIMessage = Nothing

On Error GoTo 0
Exit Sub

PermanentlyDeleteSelectedMessges_Error:

MsgBox "Error " & Err.Number & " (" & Err.Description & ") in
procedure
PermanentlyDeleteSelectedMessges of Module basExamples"
End Sub

If you want to empty the Deleted items folder, you don't need to use
CDO
because if you delete these messages again they're gone forever. This
macro
will empty the Deleted Items folder:

Sub EmptyDeletedItemsFolder()
On Error GoTo EmptyDeletedItemsFolder_Error

Dim objItem As Object, objItems As Outlook.Items
Dim objDelItemsFolder As Outlook.MAPIFolder
Dim objNS As Outlook.NameSpace
Dim intX As Integer

Set objNS = Application.GetNamespace("MAPI")
Set objDelItemsFolder =
objNS.GetDefaultFolder(olFolderDeletedItems)
Set objItems = objDelItemsFolder.Items
For intX = objItems.Count To 1 Step -1
Set objItem = objItems.Item(intX)
'Permanently delete
objItem.Delete
Next

Set objItem = Nothing
Set objItems = Nothing
Set objDelItemsFolder = Nothing
Set objNS = Nothing

On Error GoTo 0
Exit Sub

EmptyDeletedItemsFolder_Error:

MsgBox "Error " & Err.Number & " (" & Err.Description & ") in
procedure
EmptyDeletedItemsFolder of Module basExamples"
End Sub

 

[Michael Bauer [MVP - Outlook]]

Am 14 Sep 2006 09:25:31 -0700 schrieb (e-mail address removed):

1. For early binding you need to set a reference to CDO 1.21
(Tools/References)

2. The sent items folder you can get with
Application.Session.GetDefaultFolder.

Then you can loop through the folder´s Items collection.

 

[batesharold]

Thanks, Re 1, I have done that. Tools/Reference/CDO is checked.