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

  • Thread starter Thread starter Guest
  • Start date Start date
G

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
 
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?
 
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
 
*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/
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 
Back
Top