Discussion :

[Bouletinos]

Bonjour à tous,
Je cherche à réaliser une macro VBA sous Outlook pour copier sur le disque dur un email déplacé.

Je m'explique:

Ma boîte mail est structurée de la manière suivante (en gros, hein, je résume...):
- Boite de réception
- Client A
- Affaire 1
- Affaire 2
- Client B
- Affaire 3
- Affaire 4
- Eléments envoyés

Je reçois/envoie des mails, qui se retrouvent tout logiquement dans Boite de réception/Eléments envoyés.

J'ai sur mon disque dur la même arborescence de dossier CLIENT / AFFAIRE.

Je voudrais que lorsque je déplace mon email depuis Boîte de réception (ou Eléments envoyés) vers le dossier Outlook "Client A / Affaire 1", cet email soit copié dans le dossier correspondant sur mon disque dur.

Cela parait simple, mais pas moyen d'y arriver....

Pour être vraiment honnête, je suis même proche de zéro là dessus... j'ai juste un début d'intuition:
1 - Sur un événement ItemAdd, tester si le dossier n'est ni Boite de réception, ni Eléments envoyés
2 - Si c'est ok, récupérer le nom du dossier et sous dossier dans lequel je me déplace
3 - Copier le mail en me servant de l'arborescence récupérée au dessus

Mais là je patauge, et je m'en remets à vos mains expertes glissant sur vos claviers pour me donner un coup de main!!!!!

Merci d'avance et surtout bonne journée!!

[Bouletinos]

Bonjour,
Apres de très très très nombreuses recherches en Français et en Anglais, il semble que cette opération soit tout simplement impossible. Aucun événement n'existe sur le déplacement de mail.
On peut tenter de contourner le problème avec une gestion des événements au chargement du mail, mais je n'ai rien trouvé de concluant qui corresponde à ma demande.

J'ai donc changé de stratégie: plutôt que de jouer sur le déplacement du mail, j'ai joué sur sa catégorie:
J'ai crée une categorie "Sauvegardé", et j'ai demandé a Outlook, sur Fermeture (Application_Quit) de scanner tous les mails ou la catégorie "Sauvegardé" n’apparaît pas (en excluant bien sur la boite de réception elle même, ou le courrier n'est pas trié).
De la sorte, tous les soirs quand je quitte Outlook, il copie sur le serveur, dans le dossier qui convient, tous les mails traités de la journée.

Pour ce qui est du code, du coup rien de bien méchant, mais pour ceux qui ne savent pas, 2 très bonnes pistes:

Fonction Sauvegarde sur le disque par Oliv':

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
 
Sub sav_mail_as_msg(Optional objCurrentMessage As Object)
'By Oliv' juillet 2007 pour OUTLOOK 2003
 
If objCurrentMessage Is Nothing Then Set objCurrentMessage = ActiveInspector.CurrentItem
 
'Ici on construit le nom du fichier qui sera créé
NomExport = objCurrentMessage.Subject & objCurrentMessage.CreationTime
 
'Ici on défini le répertoire où l'enregistrer
repertoire = "c:\mail\"
'repertoire = BrowseForFolder("Choisissez la destination", SDossier(5, 0)) & "\"
 
'Ici on supprime les caractères non autorisé dans les noms de fichiers
PathNomExport = repertoire & "Email " & Left(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace( _
NomExport, "\", ""), "/", ""), ":", ""), "*", ""), "?", ""), "<", ""), ">", ""), "|", ""), ".", ""), """", ""), vbTab, ""), Chr(7), ""), 160) & ".msg"
 
'Ici on vérifie que le fichier n'existe pas déjà sinon il serait écrasé
n = 1
MemPath = PathNomExport
While Dir(PathNomExport) <> ""
MsgBox "Le fichier " & vbCr & PathNomExport & vbCr & "existe déjà", vbInformation
PathNomExport = Left(MemPath, Len(MemPath) - 4) & "(" & n & ")" & ".msg"
n = n + 1
 
Wend
    objCurrentMessage.SaveAs PathNomExport, OlSaveAsType.olMSG
 
End Sub
 
Sub LanceSurOuvert()
sav_mail_as_msg
End Sub
 
 
Sub LanceSurSelection()
Dim MonOutlook As Outlook.Application
Dim LeMail As Object
Dim LesMails As Outlook.Selection
Set MonOutlook = Outlook.Application
 
Set LesMails = MonOutlook.ActiveExplorer.Selection
 
    For Each LeMail In LesMails
    sav_mail_as_msg LeMail
    Next LeMail
 
Set LesMails = Nothing
MsgBox "Fin de traitement"
End Sub

Ce code est à insérer ou a gérer dans la partie "process all the items in this folder " du code suivant de Sue Mosher (très bon, et très réactif):

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
 
Sub ProcessFolder(StartFolder As Outlook.MAPIFolder)
    Dim objFolder As Outlook.MAPIFolder
    Dim objItem as Object
    On Error Resume Next
 
    ' do something specific with this folder
    Debug.Print StartFolder.FolderPath, StartFolder.Items.Count
    Debug.Print
 
    ' process all the subfolders of this folder
    For Each objFolder In StartFolder.Folders
        Call ProcessFolder(objFolder)
    Next
 
    ' process all the items in this folder
    For Each objItem In StartFolder.Items
      '  Call ProcessItem(objItem)
    Next
 
    Set objFolder = Nothing
End Sub

Je ne publie pas mon code dans la mesure où 90% est dédié à la création du chemin de sauvegarde en fonction du nom du dossier Outlook dans lequel se trouve l'email à traiter, et vu que le système de tri est propre a chacun, cela n'aurait pas trop d’Intérêt.

Ceci étant, je recommande vivement d'automatiser la création des arborescences (Explorer et Outlook) pour être sur de ne pas faire de fautes de frappe et bloquer la copie des mails.

N'ayant reçu aucune aide du forum, j'imagine que les visiteurs de ce fil seront aussi désemparés que moi la semaine dernière, alors n'hésitez pas à me contacter pour de l'aide, je ferais au mieux.

Bonne journée,
Sylvain

[Bouletinos]

Désolé pour tous ceux qui espéraient que la question "événement sur déplacement de mail" soit réellement résolue!!!
En tout cas mon problème l'est!

[Oliv-]

Bonjour,

Il y a quand même des moyens d'y parvenir.

Il faut créer un événement ItemAdd pour chaque DOSSIER OUTLOOK dont tu veux une sauvegarde sur ton disque.
il est préférable d'utiliser un module de classe pour boucler sur tous les dossiers d'une arborescence

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
 
 
Dim WithEvents colSentItems As items ' créer une variable par dossier et sous dossier.
 
Private Sub Application_Startup()
'pour evenement itemadd
   Dim NS As Outlook.NameSpace
   Set NS = Application.GetNamespace("MAPI")
   Set colSentItems = NS.GetDefaultFolder(olFolderSentMail).Items 'ici c'est le dossier éléments envoyés
   Set NS = Nothing
 'fin section
end sub

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
 
Private Sub colSentItems_ItemAdd(ByVal Item As Object)
'By Oliv ' janv 2008 pour Outlook 2003 feat. Sue Mosher
'http://www.outlookcode.com/codedetail.aspx?id=456
    If Item.Class = olMail Then
        Repertoire = "C:\"
        strName = Repertoire & "Email " & Left(remplaceCaracteresInterdit(Item.subject), 160)
        Enrg = MsgBox(Item.subject & vbCr & "sous : " & vbCr & strName & ".msg", vbYesNoCancel, "Enregistrer sur le disque ce mail ?")
        If Enrg = vbYes Then
            ' 1ère façon sans boite de dialogue on connait l'endroit où enregistrer
            'Repertoire = BrowseForFolder("Choisissez la destination", SDossier(5, 0)) & "\"
            Item.SaveAs strName & ".msg", OlSaveAsType.olMSG
 
        ElseIf Enrg = vbNo Then
            ' 2ème méthode on ouvre une boite de dialogue
            Item.Display
            Dim objInsp
            Dim colCB
            Dim objCBB
            On Error Resume Next
            Set objInsp = Item.GetInspector
            Set colCB = objInsp.CommandBars
            Set objCBB = colCB.FindControl(, 748)    'enregistrer  sous
            If Not objCBB Is Nothing Then
                objCBB.Execute
            End If
            Item.Close olDiscard
        End If
    End If
End Sub

où alors utiliser l'événement

Référence du développeur Outlook
Folder.BeforeItemMove, événement
Se produit lorsqu'un élément est sur le point d'être déplacé ou supprimé d'un dossier, à la suite de l'action d'un utilisateur ou de l'exécution du code d'un programme.
Informations sur la version
Version ajoutée : Outlook 2007

Syntaxe

expression.BeforeItemMove(Item, MoveTo, Cancel)

expression Variable qui représente un objet Folder.

Paramètres

Nom Obligatoire/Facultatif Type de données Description
Item Obligatoire Objet Représente l'élément Outlook qui doit être déplacé ou supprimé.
MoveTo Obligatoire Folder Représente le dossier vers lequel l'élément doit être déplacé.
Cancel Obligatoire Booléen Affectez la valeur True à ce paramètre pour annuler le déplacement ou la suppression.

Remarques


Cet événement se déclenche lorsque l'élément est sur le point d'être déplacé dans un autre dossier (y compris le dossier Éléments supprimés) ou lorsque l'élément est sur le point d'être supprimé définitivement. Il ne se déclenche pas au cours des opérations de synchronisation et d'archivage automatique.

Si l'action est une suppression définitive, le dossier MoveTo renvoyé dans l'événement prendra la valeur Null (Nothing dans Visual Basic).

[chnoub]

Bonjour,

je relance un peu le sujet......

Oliv quand tu dis "Il faut créer un événement ItemAdd pour chaque DOSSIER OUTLOOK dont tu veux une sauvegarde sur ton disque.
il est préférable d'utiliser un module de classe pour boucler sur tous les dossiers d'une arborescence"

ca veut dire que la macro boucle a chaque deplacement d un mail sur toute l'arbo des dossiers et sous dossiers outlook pour detecter lequel a un mail en plus?