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 = " Then
Dim oSubFolder As Outlook.MAPIFolder
Set oSubFolder =
Application.GetNamespace("MAPI").Folders.Item("wor k2006").Folders.Item("Sent
Items")
Item.Move oSubFolder
Set oSubFolder = Nothing
End If

If Item.SenderEmailAddress = " Then
Dim oSubFolder As Outlook.MAPIFolder
Set oSubFolder =
Application.GetNamespace("MAPI").Folders.Item("sal esl2006").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?

--
Ken Slovak
[MVP - Outlook]
http://www.slovaktech.com
Author: Absolute Beginner's Guide to Microsoft Office Outlook 2003
Reminder Manager, Extended Reminders, Attachment Options
http://www.slovaktech.com/products.htm


"Catalin" wrote in message
...
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 = " Then
Dim oSubFolder As Outlook.MAPIFolder
Set oSubFolder =
Application.GetNamespace("MAPI").Folders.Item("wor k2006").Folders.Item("Sent
Items")
Item.Move oSubFolder
Set oSubFolder = Nothing
End If

If Item.SenderEmailAddress = " Then
Dim oSubFolder As Outlook.MAPIFolder
Set oSubFolder =
Application.GetNamespace("MAPI").Folders.Item("sal esl2006").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

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


"Ken Slovak - [MVP - Outlook]" wrote:

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?

--
Ken Slovak
[MVP - Outlook]
http://www.slovaktech.com
Author: Absolute Beginner's Guide to Microsoft Office Outlook 2003
Reminder Manager, Extended Reminders, Attachment Options
http://www.slovaktech.com/products.htm


"Catalin" wrote in message
...
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 = " Then
Dim oSubFolder As Outlook.MAPIFolder
Set oSubFolder =
Application.GetNamespace("MAPI").Folders.Item("wor k2006").Folders.Item("Sent
Items")
Item.Move oSubFolder
Set oSubFolder = Nothing
End If

If Item.SenderEmailAddress = " Then
Dim oSubFolder As Outlook.MAPIFolder
Set oSubFolder =
Application.GetNamespace("MAPI").Folders.Item("sal esl2006").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

*Catalin 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/micro...lic.fr.outlook
Dernière chance http://www.outlookcode.com/
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~