Discussion :

[Jeremie32]

Bonjour à tous,
Je découvre VBA. J'ai besoin d'une macro pour sauvegarder mes courriels avec toujours le même format pour le nom de fichier.
J'ai trouvé sur le site celle-ci à laquelle j'ai ajouté comme info le nom de l'envoyeur.
J'aimerais ajouter une dernière chose, la notion de RD (recu de) ou EA (envoyé à).
Mes fichiers s'appeleraient donc AAAA-MM-JJ-HHMMSS_RD_PierreJeanJacques_SujetduEmail (ou EA s'il s'agit d'un courriel que j'ai envoyé).

Est-ce qu'on peut demander à la macro d'analyser si je suis dans la boite de reception (pour dans ce cas ajouter le RD) ou dans les éléments envoyés (pour mettre EA) ?
Rendu là ca dépasse largement mes compétences...

Voici le code que j'ai présentement.

Merci d'avance!

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
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
Option Explicit
 
Function BrowseForFolder(Optional OpenAt As Variant) As Variant
     Dim ShellApp As Object
     Set ShellApp = CreateObject("Shell.Application"). _
    BrowseForFolder(0, "Please choose a folder", 0, OpenAt)
 
    On Error Resume Next
       BrowseForFolder = ShellApp.self.Path
    On Error GoTo 0
 
    Set ShellApp = Nothing
       Select Case Mid(BrowseForFolder, 2, 1)
           Case Is = ":"
               If Left(BrowseForFolder, 1) = ":" Then GoTo Invalid
           Case Is = "\"
               If Not Left(BrowseForFolder, 1) = "\" Then GoTo Invalid
           Case Else
               GoTo Invalid
       End Select
    Exit Function
 
Invalid:
    BrowseForFolder = False
End Function
 
 
Public Sub SaveMessageAsMsg()
     Dim oMail As Outlook.MailItem
     Dim objItem As Object
     Dim sPath, strFolderpath As String
     Dim dtDate As Date
     Dim sName As String
     Dim enviro As String
 
       enviro = CStr(Environ("USERPROFILE"))
      For Each objItem In ActiveExplorer.Selection
      If objItem.MessageClass = "IPM.Note" Then
       Set oMail = objItem
 
     sName = oMail.Subject
     ReplaceCharsForFileName sName, "-"
 
     dtDate = oMail.ReceivedTime
     sName = Format(dtDate, "yyyymmdd", vbUseSystemDayOfWeek, _
       vbUseSystem) & Format(dtDate, "-hhnnss", _
       vbUseSystemDayOfWeek, vbUseSystem) & "-" & sName & ".msg"
 
 
 
     strFolderpath = BrowseForFolder("D:\test\mails\")
     sPath = strFolderpath & "\"
     Debug.Print sPath & sName
     oMail.SaveAs sPath & sName, olMSG
 
     End If
     Next
 
End Sub
 
Private Sub ReplaceCharsForFileName(sName As String, _
     sChr As String _
)
     sName = Replace(sName, "'", sChr)
     sName = Replace(sName, "*", sChr)
     sName = Replace(sName, "/", sChr)
     sName = Replace(sName, "\", sChr)
     sName = Replace(sName, ":", sChr)
     sName = Replace(sName, "?", sChr)
     sName = Replace(sName, Chr(34), sChr)
     sName = Replace(sName, "<", sChr)
     sName = Replace(sName, ">", sChr)
     sName = Replace(sName, "|", sChr)
End Sub

[Oliv-]

Salut

Tu peux t'aider de ce code
https://www.developpez.net/forums/d1.../#post11040029

[Jeremie32]

Merci Oliv-

Ca marche parfaitement mais seulement quand le courriel que je veux sauvegarder est complètement ouvert (quand j'ai double clique dessus).
Si je suis dans la boite de réception et que je "Highlight" simplement le courriel que je veux sauvegarder, ca me génère une erreur.

Est-ce qu'il y a un moyen de contourner ca ? car pour être honnête il est plus pratique de simplement sélectionner le email que d'avoir à l'ouvrir au complet.

Merci encore!

[Oliv-]

Bonjour,

Si tu fais

Code :

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

1
2
For Each objItem In ActiveExplorer.Selection
...

le traitement se fait sur les Emails sectionnés dans l'explorer outlook.

si tu veux prendre l'élement actif (au choix le mail ouvert ou le 1er mail selectionné)

Code :

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

1
2
3
4
5
6
7
'choix de l'élément ACTIF
    Set objItem  = Application.ActiveWindow
    If TypeOf objItem Is Outlook.Inspector Then
        Set objItem = objItem.CurrentItem
    Else
        Set objItem = objItem.Selection(1)
    End If

[Jeremie32]

Salut Oliv-,

Je me rend compte que j'utilise oMail.SenderName pour ajouter le nom de la personne m'ayant envoyé un email.
Quel est l'équivalent pour obtenir le nom de la personne à qui j'ai envoyé un email ?

Merci !!

[Oliv-]

c'est dans la collection des .recipients

en fait y en pas forcèment 1 seul c'est dnc différent du sender

[Jeremie32]

Ok, pas sûr d'avoir bien compris.
J'ai cherché avec recipient mais il me propose seulement RecipientS.
Sauf que je ne sais pas comment pluger ca dans la macro pour qu'il me retourne le nom de la personne a qui j'ai envoyé mon courriel.
Aurais-tu un exemple concrêt ?

Merci

[Oliv-]

Voici 2 méthodes qui ne renvoient pas forcèment les mêmes infos.

Code :

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

1
2
3
4
5
6
7
8
      MsgBox  objmail.To
       MsgBox  objmail.CC
        MsgBox  objmail.Bcc
 
        Dim Destinataire As Recipient
        For Each Destinataire In objmail.Recipients
            MsgBox Destinataire.Name & vbCr & Destinataire.Address & vbCr & Destinataire.Type
        Next Destinataire

avec pour type

olBCC 3 Le destinataire est spécifié dans la propriété BCC de l' élément.
olCC 2 Le destinataire est spécifié dans la propriété CC de l' élément.
olTo 1 Le destinataire est spécifié dans la propriété to de l' élément.

[Jeremie32]

Bon, après quelques déboires, ca semble bien fonctionner. Je vais essayer de ne plus trop toucher car une simple modification a fait en sorte que plus rien de marchait et j'ai mis du temps à trouver de quoi il s'agissait…

Dans ma macro, quand je sauvegarde les courriels, la boite de dialogue me permet de choisir un chemin dans l'explorateur, par contre je n'ai pas accès à modifier le nom.
Ma macro est faite pour donner un nom du type date_heure_Recu_NomExpediteur_TitreduCourriel et j'aimerais aussi avoir la possibilité de changer le titre du courriel d'origine (parfois il est trop long pour rien, ou parfois pas assez évocateur). L'idéal serait donc que dans la boite qui s'ouvre pour enregistrer le email, le nom modifié apparaisse (incluant les ajouts de dates etc... qui j'y ai fait) et que ca me laisse la possibilité de modifier le sujet de courriel initial.
Je crois que dans ma macro, la portion qui fait afficher la boite de dialogue en question est la suivante (récupérée d'une autre macro, désolé pour le plagiat):

Code :

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

1
2
3
4
     strFolderpath = BrowseForFolder("D:\General")
     sPath = strFolderpath & "\"
     Debug.Print sPath & sName
     oMail.SaveAs sPath & sName

Comment faudrait-il que je modifie ca pour arriver à mes fins ?

Merci d'avance!!

[Oliv-]

Code :

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

sName = InputBox("Corriger le nom", , sName)

attention au caractères interdits dans le nom d'un fichier ! tu peux utiliser cette fonction

Code :

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

sName  = remplaceCaracteresInterdit(Sname)

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
Private Function remplaceCaracteresInterdit(ByVal CheminStr As String)
    Dim ObjCurrentMessage As Outlook.MailItem
 
    Dim liste As Variant
    Dim L
    liste = Array("\", "/", ":", "*", "?", "<", ">", "|", """", vbTab, Chr(7))
    For L = 0 To UBound(liste)
        CheminStr = Replace(CheminStr, liste(L), "")
    Next L
    remplaceCaracteresInterdit = Trim(CheminStr)
    'MsgBox CheminStr
End Function