Thank you very much for below but I made a complete mess of the above
post, the routines are actually as follows. I was in a round about way
trying to figure how to permanently emty the sent folder when the user
exits Outlook.

Sub DeleetSent2()
Dim objSentItems As Outlook.MAPIFolder, objSentItem As Object
Dim objItems As Outlook.Items, objNS As Outlook.NameSpace
Dim intX As Integer

Set objNS = Application.GetNamespace("MAPI")
Set objSentItems = objNS.GetDefaultFolder(olFolderSentMail)
Set objItems = objSentItems.Items
For intX = objItems.Count To 1 Step -1
Set objSentItem = objItems.Item(intX)
objSentItem.Delete
Next

End Sub

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] wrote:

Am 14 Sep 2006 09:17:56 -0700 schrieb :

If Quit fires the objects, e.g. ActiveExplorer, are not more valid. Instead
you can use an Explorer wrapper and call your code if the last Explorer
object closes.

--
Viele Gruesse / Best regards
Michael Bauer - MVP Outlook
-- www.VBOffice.net --


I have been using the following script posted earlier on this forum and
it works fine, I tried to be clever by executing it on This Outlook
Session Quit (why doesn't it have a before close event?) and it gives
an internal error. I would be grateful if someone could tell me what I
should be doing. I am using Outlook 2003

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