Discussion :

[atelea]

Bonjour à tous,

je lance mon premier post sur notre beau forum car, malgré mes recherches, je ne trouve pas de solutions...
Voilà, je souhaiterai lister sur une feuille Excel les fichiers au format Outlook (.msg) stockés dans un répertoire.
En m'inspirant très largement d'un exemple fourni sur le site, je parviens à extraire les données liées à la classe FIle (date de création, nom, taille, dossier parent...)
Mais je souhaiterai en outre extraire dans une colonne supplémentaire de ma feuille Excel le nom de l'expéditeur du mail. En fait, il me faudrait l'objet SenderEmailAddress ou SenderName (MailItem). Savez-vous comment recueillir cette information contenue dans le fichier .msg ?

Pour mieux me faire comprendre, voici le code sur lequel je travaille.
D'avance merci pour votre aide !!

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
 Sub TestListeFichiers()
    Dim Dossier As String
 
    'Définit le répertoire pour débuter la recherche de fichiers.
    Dossier = "D:\mes mails"
 
        'Appelle la procédure de recherche des fichiers
    ListeFichiers Dossier
 
    MsgBox "Terminé."
End Sub
 
Sub ListeFichiers(Repertoire As String)
    '
    'Nécessite d'activer la référence "Microsoft Scripting RunTime"
        'Dans l'éditeur de macros (Alt+F11):
        'Menu Outils
        'Références
        'Cochez la ligne "Microsoft Scripting RunTime".
        'Cliquez sur le bouton OK pour valider.
 
    Dim Fso As Scripting.FileSystemObject
    Dim SourceFolder As Scripting.Folder
    Dim SubFolder As Scripting.Folder
    Dim FileItem As Scripting.File
    Dim I As Long
 
    Set Fso = CreateObject("Scripting.FileSystemObject")
    Set SourceFolder = Fso.GetFolder(Repertoire)
 
    'Récupère le numéro de la dernière ligne vide dans la colonne A.
    I = Range("A65536").End(xlUp).Row + 1
 
    'Boucle sur tous les fichiers du répertoire
    For Each FileItem In SourceFolder.Files
        'Inscrit le nom du fichier dans la cellule
        Cells(I, 1) = FileItem.Name
        'Ajoute un lien hypertexte vers le fichier
        ActiveSheet.Hyperlinks.Add Anchor:=Cells(I, 1), _
            Address:=FileItem.ParentFolder & "\" & FileItem.Name
        'Indique la date d'envoi
        Cells(I, 3) = FileItem.DateLastModified
        'Indique la date de dernier acces
        Cells(I, 4) = FileItem.Type
        'Indique la taille
        Cells(I, 5) = FileItem.Size
 
        I = I + 1
    Next FileItem
 
    '--- Appel récursif pour lister les fichier dans les sous-répertoires ---.
    For Each SubFolder In SourceFolder.subfolders
        ListeFichiers SubFolder.Path
    Next SubFolder
 
End Sub

[BlueMonkey]

Salut,

Si tu dispose d'Outlook, tu peux utiliser les objects du type Outlook.MailItem et la fonction
CreateItemFromTemplate(<fichier msg>) pour récupérer le nom de l'expéditeur du mail à partir du fichier msg.

Il faut juste ajouter un référence supplémentaire depuis l'éditeur VBA : Microsoft Outlook 14.0 Object Library pour office 2010

A noter que :
- FileItem.Path renvoie directement FileItem.ParentFolder & "\" & File.Name.
- Range("A" & Rows.Count) est préférable à Range("A65536") car le nombre de ligne max change suivant les versions d'Excel.

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
Sub ListeFichiers(Repertoire As String)
    '
    'Nécessite d'activer les références :
    '        "Microsoft Scripting RunTime"
    '        "Microsoft Outlook 1x.0 Object Library"
        'Dans l'éditeur de macros (Alt+F11):
        'Menu Outils
        'Références
        'Cochez la ligne "Microsoft Scripting RunTime".
        'Cochez la ligne "Microsoft Outlook 1x.0 Object Library".
        'Cliquez sur le bouton OK pour valider.
 
    Dim Fso As Scripting.FileSystemObject
    Dim SourceFolder As Scripting.Folder
    Dim SubFolder As Scripting.Folder
    Dim FileItem As Scripting.File
    Dim I As Long
 
    Set Fso = CreateObject("Scripting.FileSystemObject")
    Set SourceFolder = Fso.GetFolder(Repertoire)
 
    'Récupère le numéro de la dernière ligne vide dans la colonne A.
    I = Range("A" & Rows.Count).End(xlUp).Row + 1
 
    Dim OApp As Outlook.Application
    Set OApp = New Outlook.Application
    Dim msg As Outlook.MailItem
 
    'Boucle sur tous les fichiers du répertoire
    For Each FileItem In SourceFolder.Files
        'Inscrit le nom du fichier dans la cellule
        Cells(I, 1) = FileItem.Name
        'Ajoute un lien hypertexte vers le fichier
        ActiveSheet.Hyperlinks.Add Anchor:=Cells(I, 1), Address:=FileItem.Path
        'Indique la date d'envoi
        Cells(I, 3) = FileItem.DateLastModified
        'Indique la date de dernier acces
        Cells(I, 4) = FileItem.Type
        'Indique la taille
        Cells(I, 5) = FileItem.Size
 
        'Indique le nom de l'expéditeur
        Set msg = OApp.CreateItemFromTemplate(FileItem.Path)
        Cells(I, 6) = msg.SenderEmailAddress
        Set msg = Nothing
        I = I + 1
    Next FileItem
 
    '--- Appel récursif pour lister les fichier dans les sous-répertoires ---.
    For Each SubFolder In SourceFolder.subfolders
        ListeFichiers SubFolder.Path
    Next SubFolder
 
    Set OApp = Nothing
End Sub

[atelea]

Bonjour BlueMonkey !
Extraordinaire, c'est parfait, cela répond exactement à ce que je recherchais... Merci pour tout !!
et en plus, tu as amélioré le code...
Je passe la discussion en "résolue".
Bonne continuation