Bonjour,

J'ai besoin de créer une macro dans Outlook qui me permet d'archiver mes messages, j'ai pour cela un pseudo cahier des charges et ai commencé à récupérer à droite à gauche divers bouts de code pour dégrossir le projet. (ça fait longtemps que j'ai pas fait de programmation et j'ai vraiment du mal à m'y remettre)

J'ai un serveur avec une arborescence :
X:\Affaire\XXXX_NomAffaire_Client\Emails

J'ai Outlook 2010 et un dossier qui s'appelle "XXXX_NomAffaire"

> Je déplace mes messages dans leurs dossiers respectifs Outlook après réception

Je voudrais pouvoir sélectionner mon dossier "XXXX_NomAffaire" et lancer ma macro pour :
- Qu'elle cherche dans x:\ le dit dossier "XXXX_NomAffaire" et enregistre le chemin dans une variable
- Enregistre dans cette destination tous les messages du dossier au format "XXXX_NomAffaire"_"Date"_"Expéditeur"_"Sujet" (avec une limite de caractère, mais je ne sait pas combien il faudrait mettre)
> En cas de doublon, incrémenter (1)
- Demande la suppression des messages dans le dossier Outlook une fois exportés

J'ai récupéré et modifié :
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
51
52
53
54
 
Sub sav_mail_as_msg(Optional objCurrentMessage As Object)
 
Dim MonApply As Outlook.Application
Dim Expl As Explorer
Dim myNameSpace As NameSpace
Dim myFolder As MAPIFolder
Dim myItems As Items
Dim xi As Integer
 
Set MonApply = Outlook.Application
Set Expl = ActiveExplorer
Set myNameSpace = MonApply.GetNamespace("MAPI")
 
    If objCurrentMessage Is Nothing Then Set objCurrentMessage = ActiveInspector.CurrentItem
 
    'Nom du fichier qui sera créé
    NomExport = objCurrentMessage.CreationTime & " " & objCurrentMessage.SenderName & "_" & objCurrentMessage.Subject
 
    'Ici on défini le répertoire où l'enregistrer
    repertoire = "c:\mail\"
 
    'Ici on supprime les caractères non autorisé dans les noms de fichiers
    PathNomExport = repertoire & Expl & "-" & 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 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 morceau de code me permet de formater presque correctement le nom du message enregistre ma sélection dans c:\mail\

Problèmes :
- Je ne sais pas comment prendre le problème de la recherche du dossier sur le serveur
- Je ne sais pas comment dire enregistrer "le contenu complet du dossier" et non "ma sélection de message"
- l'attribut objCurrentMessage.CreationTime me colle l'heure ... je n'arrive pas à trouver celui qui me formaterais la date "AnnéeMoisJour"
- Je pense que la fonction vidage est secondaire à cet étape de developpement

Si une âme charitable sait me venir en aide ... je continue à gratter de mon coté ^^

Merci