Moving sent items instead of copying them to "Sent items" folder

[Guest]

Dear Friends,

Please help me with this problem:
I use OL 2003 and I need to move the sent items based on the acoount through
which they are being sent. I have to mention that I have 3 accounts as well.
I have a code which is presented below but it doesn't seem to work.

Option Explicit

Public WithEvents SentItemsAdd As Items

Private Sub Application_MAPILogonComplete()
Set SentItemsAdd =
Application.GetNamespace("MAPI").GetDefaultFolder(olFolderSentMail).Items
End Sub

Private Sub SentItemsAdd_ItemAdd(ByVal Item As Object)
If Item.SenderEmailAddress = "(e-mail address removed)" Then
Dim oSubFolder As Outlook.MAPIFolder
Set oSubFolder =
Application.GetNamespace("MAPI").Folders.Item("work2006").Folders.Item("Sent
Items")
Item.Move oSubFolder
Set oSubFolder = Nothing
End If

If Item.SenderEmailAddress = "(e-mail address removed)" Then
Dim oSubFolder As Outlook.MAPIFolder
Set oSubFolder =
Application.GetNamespace("MAPI").Folders.Item("salesl2006").Folders.Item("Sent Items")
Item.Move oSubFolder
Set oSubFolder = Nothing
End If

'and so on

End Sub

The event is not triggered.

Can somebody help?

Thanks in advance,
Catalin

 

[Ken Slovak - [MVP - Outlook]]

This code is in the Outlook VBA project, in the ThisOutlookSession class
module? If so move the initialization code to Application_Startup and see
what happens. Are macros enabled or disabled for your setup?

 

[Guest]

Yes the code is in the ThisOutlookSession class module. The macros are
enabled as well.

I will try your suggestion and come back to you.

Thanks for your answer.
Catalin

 

[Oliv']

*Catalin <[email protected]> que je salut a écrit *:

try with this example :


Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
Dim prompt As String
Dim objCurrentMessage As MailItem
Dim objNS As NameSpace
Dim objFolder As MAPIFolder

On Error GoTo fin
Set objCurrentMessage = Item

If objCurrentMessage.DeleteAfterSubmit = False Then
Title = "Voulez-vous garder une copie de ce mail ?"
prompt = Item.Subject + vbCr + vbCr + "[OUI] vous choisissez le
répertoire, [NON] envoi sans garder de copie" + vbCr + vbCr + "[ANNULER]
dans 'Sélectionner un dossier' envoi en gardant copie dans 'éléments
supprimés'"
copie = MsgBox(prompt, vbYesNoCancel + vbQuestion + vbDefaultButton2,
Title)
If copie = 2 Then
Cancel = True
GoTo fin
End If
If copie = vbNo Then
objCurrentMessage.DeleteAfterSubmit = True
Else

Set objNS = Application.GetNamespace("MAPI")
Set objFolder = objNS.PickFolder
If TypeName(objFolder) = "Nothing" Then
Set objNS = Application.GetNamespace("MAPI")
Set objFolder = objNS.GetDefaultFolder(olFolderDeletedItems)
End If
Set Item.SaveSentMessageFolder = objFolder

Set objFolder = Nothing
Set objNS = Nothing
End If
End If
fin:
End Sub


--
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Have a nice day
Oliv'
Outlook : http://faq.outlook.free.fr/
les archives : http://groups.google.com/group/microsoft.public.fr.outlook
Dernière chance http://www.outlookcode.com/
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~