B
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
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