Help with a script

[batesharold]

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

 

[batesharold]

PS: The same script when called from This Outlook Session Startup works
like a charm!

 

[batesharold]

Sorry Correction to original post, it's Outlook 2000 SR-1 not 2003

 

[Michael Bauer [MVP - Outlook]]

Am 14 Sep 2006 09:17:56 -0700 schrieb (e-mail address removed):

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.

 

[batesharold]

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

Am 15 Sep 2006 02:32:11 -0700 schrieb (e-mail address removed):

Sorry, is this a new question? Call the code when the last explorer closes,
from within Application_Quit it doesn´t work.

 

[batesharold]

OK thanks, please be patient, bit new to this, how do I that?

 

[Michael Bauer [MVP - Outlook]]

Am 18 Sep 2006 04:08:27 -0700 schrieb (e-mail address removed):

Do you use VB6 or VBA? If VB6, you could look at the sample on
http://www.microeye.com/resources/itemsCB.htm

At least you need a class module, that´s the wrapper for the Outlook
Explorer objects:

<ExplorerWrapper>
Private WithEvents Explorer As Outlook.Explorer

Friend Sub Init(Expl as Outlook.Explorer)
Set Explorer=Expl
End Sub

Private Sub Explorer_Close()
If Explorer.Parent.Explorers.Count<=1 Then
' Quit
Endif
Set Explorer=Nothing
End Sub
</ExplorerWrapper>

In ThisOutlookSession you need at least this:

<ThisOutlookSession>
Private WithEvents Explorers As Outlook.Explorers
Private Coll as VBA.Collection

Private Sub Application_Startup()
Set Explorers = Application.Explorers
Set Coll=new VBA.Collection
End Sub

Private Sub Explorers_NewExplorer(ByVal Explorer As Outlook.Explorer)
Dim Expl as ExplorerWrapper
Set Expl=New ExplorerWrapper
Expl.Init Explorer
Coll.Add Expl
End Sub
</ThisOutlookSession>

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

OK thanks, please be patient, bit new to this, how do I that?

Am 15 Sep 2006 02:32:11 -0700 schrieb (e-mail address removed):

Sorry, is this a new question? Call the code when the last explorer closes,
from within Application_Quit it doesn´t work.

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

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 (e-mail address removed):

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