Discussion :

[Oliv-]

Salut il faut changer
Set objFolder = objNS.PickFolder
par
l'emplacement de ton dossier

Si c'est un sous dossier de la boite de reception par defaut
= GetDefaultFolder(olFolderInbox).folders("toto")
Dossier au même niveau
= GetDefaultFolder(olFolderInbox).parent.folders("toto")

[HecsS]

Merci,

Je viens d'essayé mais j'ai ce message :

"Sub ou Function non définie" au niveau de "GetDefaultFolder"

Voilà le code :

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As _
Boolean)


If Not Item.Class = olMail Then GoTo fin

Dim objNS As NameSpace
Dim objFolder As MAPIFolder

Set objNS = Application.GetNamespace("MAPI")
Set objFolder = GetDefaultFolder(olFolderInbox).Parent.Folders("toto") <---
If TypeName(objFolder) = "Nothing" Then
Set objNS = Application.GetNamespace("MAPI")
Set objFolder = objNS.GetDefaultFolder(olFolderDeletedItems)
End If
Set Item.SaveSentMessageFolder = objFolder
fin:



End Sub

Merci !

[Oliv-]

Désolé c'est

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Set objFolder = objNS.GetDefaultFolder(olFolderInbox).Parent.Folders("toto")

bien sur il faut remplacer toto par ton vrai nom

le bloc if suivant n'est pas nécessaire :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
'If TypeName(objFolder) = "Nothing" Then
'Set objNS = Application.GetNamespace("MAPI")
'Set objFolder = objNS.GetDefaultFolder(olFolderDeletedItems)
'End If

[HecsS]

Re-bonjour,

celà fonctionne très bien quand le dossier est dans la boite de réception et que j'utilise juste "folders", mais si je mets le dossier dans les dossier d'archivage, là même avec "parent.Folders" ça fonctionne pas...et je ne sais pas comment on fait pour créer un dossier même niveau que la boite de réception...


Merci !

[Oliv-]

Ah bin oui mais je ne lis pas encore dans tes pensées ...

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Set objFolder = objNS.Folders("Dossiers d'archivage").Folders("Archive")

[HecsS]

Désolé...en effet, difficile pour toi de deviner :-)

Un grand merci !

[HecsS]

Re-bonjour :-),

J'ai encore une petite question : comment faire pour qu'il ne fasse cette action que si il y a le mot "toto" dans l'objet ?

Merci !

[Oliv-]

Avec cela ca devrait fonctionner

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

If Not ucase(Item.subject) like "*TOTO*" Then GoTo fin

a mettre en dessous de

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

If Not Item.Class = olMail Then GoTo fin

[HecsS]

Merci de ta rapidité !

Mais je viens d'essayé mais ça ne fonctionne pas...

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As _
Boolean)


If Not Item.Class = olMail Then GoTo fin
If Not UCase(Item.Subject) Like "*toto*" Then GoTo fin

Dim objNS As NameSpace
Dim objFolder As MAPIFolder

Set objNS = Application.GetNamespace("MAPI")
Set objFolder = objNS.Folders("Dossiers d'archivage").Folders("Archive")
If TypeName(objFolder) = "Nothing" Then
Set objNS = Application.GetNamespace("MAPI")
Set objFolder = objNS.GetDefaultFolder(olFolderDeletedItems)
End If
Set Item.SaveSentMessageFolder = objFolder
fin:

End Sub

J'imagine que les étoiles * sont a enlevés ? Mais même avec ça ne fonctionne pas...mais pas de message d'erreur, juste que le message n'est pas déplacer. Comme si il ne lisait pas que le sujet est bien le même...



Merci

[HecsS]

Oups....

Merci !!!

[Oliv-]

Non c'est bien "*TOTO*" en majuscules et avec les étoiles pour prendre en compte si le mot et précédé ou suivi de quelque chose.