Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

VBA Outlook Discussion :

Lister des mails de fichiers PST dans Excel


Sujet :

VBA Outlook

  1. #1
    Membre habitué
    Lister des mails de fichiers PST dans Excel
    Bonjour à tous,

    Je cherche à lister un très grand nombre de mails dans Excel contenus dans plusieurs fichiers PST ouverts sur mon Outlook. J'ai une macro me permettant de lister comme je veux les mails de ma boîte de réception, mais je ne trouve pas comment "sortir" de la boite de réception pour lister ce qui se trouve dans les PST.

    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
    Sub mails()
     
    Dim olapp As New Outlook.Application
    Dim ns As Object, Dossier As Object
    Dim i As Object
     
    Set ns = olapp.GetNamespace("MAPI")
    Set Dossier = ns.GetDefaultFolder(olFolderInbox) 'C'est ici que ça bloque, comment préciser que ce n'est pas la boîte de réception qui est concernée ?
    b = 2
     
    For Each i In Dossier.Items
        Cells(b, 1) = i.Subject
        Cells(b, 2) = i.ReceivedTime
        Cells(b, 3) = i.SenderEmailAddress
        b = b + 1
    Next i
    End Sub


    J'ai bien cherché dans la bibliohthèque ici : https://msdn.microsoft.com/en-us/vba/outlook-vba/articles/oldefaultfolders-enumeration-outlook, mais rien ne correspond à mon besoin puisqu'il ne s'agit que des dossiers et éléments présents par défaut sur Outlook, contrairement à mes dossiers de fichiers PST qui sont à part de ma boîte de réception.

    Merci d'avance pour votre aide !

  2. #2

  3. #3
    Membre habitué
    Bonjour,

    Super, ça fonctionne ! Par contre, comment puis-je faire pour parcourir également les sous dossiers du dossier sélectionné ? Parce qu'il y en a un paquet, si je pouvais éviter de les faire un à un...

    Voici où j'en suis maintenant :

    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
    Sub mails()
     
    Dim olapp As New Outlook.Application
    Dim ns As Object
    Dim i As Object
    Dim oFolder As Object
     
    Dim OL As Object
        If UCase(Application) = "OUTLOOK" Then
            Set OL = Application
        Else
            Set OL = CreateObject("outlook.application")
        End If
     
    Set ns = olapp.GetNamespace("MAPI")
     
    Set oFolder = OL.Session.PickFolder
    b = 2
     
    For Each i In oFolder.Items
        Cells(b, 1) = i.Subject
        Cells(b, 2) = i.ReceivedTime
        Cells(b, 3) = i.SenderEmailAddress
        b = b + 1
    Next i
    End Sub


    Merci d'avance !

  4. #4
    Expert éminent
    En fait c'est tout le code que tu dois appliquer car c'est la méthode la plus rapide !

    pas juste le pickFolder

    par contre ce n'est pas récursif , pour cela il faut que tu mixes avec ce code là
    https://www.developpez.net/forums/bl...sous-dossiers/

  5. #5
    Membre habitué
    Hum, c'est dense... Du coup j'ai voulu remplacer le code de "Sub ProcessThisItem" par celui de "Sub ExportFolderItemsToExcel", mais ça boucle à l'infini en me demandant de sélectionner un folder...

    Je suppose que c'est plus que complexe que de simplement mettre dans la fonction de traitement du mail celle servant à exporter les mails sur Excel ?

  6. #6
    Expert éminent
    Dans mon idée tu aurais pris le traitement récursif et récupéré les infos via gettable.

    Mais tu peux aussi utiliser le traitement récursif et à l’endroit où c'est noté

    Code :Sélectionner tout -Visualiser dans une fenêtre à part
     'ici le code


    tu mets ton code initial ce sera juste plus long à traiter.

    Code :Sélectionner tout -Visualiser dans une fenêtre à part
    1
    2
    3
    4
        Cells(b, 1) = MyMail.Subject
        Cells(b, 2) = MyMail.ReceivedTime
        Cells(b, 3) = MyMail.SenderEmailAddress
        b = b + 1

  7. #7
    Membre habitué
    Ca marche... presque Le traitement se fait bien, mais le résultat dans Excel s'inscrit toujours dans la même plage de cellules, plutôt que d'être listé. Chaque mail vient donc effacer le résultat précédent, et quand le traitement est terminé, je n'ai qu'un seul mail listé, le dernier qui a été traité.

  8. #8
    Expert éminent
    Bonjour,

    Si tu ne publies pas le code que tu utilises, je ne pourrai pas t'aider à trouver l'erreur

  9. #9
    Membre habitué
    Désolée, pas pensé du coup parce que j'ai d'abord essayé en reprennant tel quel, et comme ça ne marchait pas j'ai essayé d'adapter au niveau de la fonction "ProcessThisItem". Voila le code :

    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
    75
    76
    77
    78
    79
    80
    81
    82
    83
    84
    85
    86
    87
    88
    89
    90
    91
    92
    93
    94
    95
    96
    97
    Option Explicit
     
    Sub Lance_Traitement()
    '---------------------------------------------------------------------------------------
    ' Procedure : Lance_Traitement
    ' Author    : Oliv
    ' Date      : 12/02/2016
    ' Purpose   :
    '---------------------------------------------------------------------------------------
    '
        Dim OL As Outlook.Application
        Dim olNS As Outlook.Namespace
        Dim olFolder As Outlook.Folder
     
        Set OL = Outlook.Application
        Set olNS = OL.GetNamespace("MAPI")
     
        'soit on connait le dossier
        'Set olFolder = olNS.GetDefaultFolder(olFolderInbox).folders
     
        'soit on le choisi
        Set olFolder = olNS.PickFolder
     
        Call ProcessFolders(olFolder, True)
        MsgBox "Traitement terminé"
    End Sub
     
     
    Sub ProcessFolders(StartFolder As Outlook.MAPIFolder, SubFolder As Boolean)
    '---------------------------------------------------------------------------------------
    ' Procedure : ProcessFolder
    ' Author    : Oliv'
    ' Date      : 12/02/2016
    ' Purpose   : Traitement récursif sur les dossiers OUTLOOK
    '---------------------------------------------------------------------------------------
    '
        Dim objFolder As Outlook.MAPIFolder
        Dim objitem As Object
     
        'Dim objItem As Object
        On Error Resume Next
     
        ' do something specific with this folder
        Debug.Print StartFolder.FolderPath, StartFolder.Items.Count
        Debug.Print
        If StartFolder.DefaultItemType = olMailItem Then
            '  ICI LE TRAITEMENT POUR CHAQUE DOSSIER
            ' Call ProcessThisFolder(StartFolder)
        End If
     
        ' process all the items in this folder
        'ICI LE TRAITEMENT POUR TOUS LES ELEMENTS DU DOSSIER
     
        Dim i
        For i = StartFolder.Items.Count To 1 Step -1
            Set objitem = StartFolder.Items(i)
            Call ProcessThisItem(objitem)
        Next i
     
        ' process all the subfolders of this folder
        'on traite tous les sous dossiers
        If SubFolder Then
            For Each objFolder In StartFolder.Folders
                Call ProcessFolders(objFolder, SubFolder)
            Next
        End If
     
        Set objFolder = Nothing
    End Sub
     
     
    Sub ProcessThisItem(objitem As Object)
    '---------------------------------------------------------------------------------------
    ' Procedure : ProcessThisItem
    ' Author    : Oliv
    ' Date      : 12/02/2016
    ' Purpose   :
    '---------------------------------------------------------------------------------------
    '
        If objitem.Class = olMail Then
            Dim MyMail As Outlook.MailItem
            Set MyMail = objitem
        Dim b
        Dim olFolder As Outlook.Folder
     
        'ici le code
        b = 2
     
    For Each MyMail In olFolder.Items
        Cells(b, 1) = MyMail.Subject
        Cells(b, 2) = MyMail.ReceivedTime
        Cells(b, 3) = MyMail.SenderEmailAddress
        b = b + 1
    Next MyMail
        End If
     
    End Sub


    Merci d'avance

  10. #10

  11. #11
    Membre habitué
    Malheureusement, toujours pas, exactement le même problème qu'avant

    Le code avec les deux modifications :

    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
    75
    76
    77
    78
    79
    80
    81
    82
    83
    84
    85
    86
    87
    88
    89
    90
    91
    92
    93
    94
    95
    96
    97
    98
    99
    100
    Option Explicit
     
    Dim B
     
    Sub Lance_Traitement()
    '---------------------------------------------------------------------------------------
    ' Procedure : Lance_Traitement
    ' Author    : Oliv
    ' Date      : 12/02/2016
    ' Purpose   :
    '---------------------------------------------------------------------------------------
    '
        Dim OL As Outlook.Application
        Dim olNS As Outlook.Namespace
        Dim olFolder As Outlook.Folder
     
        Set OL = Outlook.Application
        Set olNS = OL.GetNamespace("MAPI")
     
        'soit on connait le dossier
        'Set olFolder = olNS.GetDefaultFolder(olFolderInbox).folders
     
        'soit on le choisi
        Set olFolder = olNS.PickFolder
     
        Call ProcessFolders(olFolder, True)
     
        B = 2
     
        MsgBox "Traitement terminé"
    End Sub
     
     
    Sub ProcessFolders(StartFolder As Outlook.MAPIFolder, SubFolder As Boolean)
    '---------------------------------------------------------------------------------------
    ' Procedure : ProcessFolder
    ' Author    : Oliv'
    ' Date      : 12/02/2016
    ' Purpose   : Traitement récursif sur les dossiers OUTLOOK
    '---------------------------------------------------------------------------------------
    '
        Dim objFolder As Outlook.MAPIFolder
        Dim objitem As Object
     
        'Dim objItem As Object
        On Error Resume Next
     
        ' do something specific with this folder
        Debug.Print StartFolder.FolderPath, StartFolder.Items.Count
        Debug.Print
        If StartFolder.DefaultItemType = olMailItem Then
            '  ICI LE TRAITEMENT POUR CHAQUE DOSSIER
            ' Call ProcessThisFolder(StartFolder)
        End If
     
        ' process all the items in this folder
        'ICI LE TRAITEMENT POUR TOUS LES ELEMENTS DU DOSSIER
     
        Dim i
        For i = StartFolder.Items.Count To 1 Step -1
            Set objitem = StartFolder.Items(i)
            Call ProcessThisItem(objitem)
        Next i
     
        ' process all the subfolders of this folder
        'on traite tous les sous dossiers
        If SubFolder Then
            For Each objFolder In StartFolder.Folders
                Call ProcessFolders(objFolder, SubFolder)
            Next
        End If
     
        Set objFolder = Nothing
    End Sub
     
     
    Sub ProcessThisItem(objitem As Object)
    '---------------------------------------------------------------------------------------
    ' Procedure : ProcessThisItem
    ' Author    : Oliv
    ' Date      : 12/02/2016
    ' Purpose   :
    '---------------------------------------------------------------------------------------
    '
        If objitem.Class = olMail Then
            Dim MyMail As Outlook.MailItem
            Set MyMail = objitem
     
        Dim olFolder As Outlook.Folder
     
        'ici le code
    For Each MyMail In olFolder.Items
        Cells(B, 1) = MyMail.Subject
        Cells(B, 2) = MyMail.ReceivedTime
        Cells(B, 3) = MyMail.SenderEmailAddress
        B = B + 1
    Next MyMail
        End If
     
    End Sub

  12. #12

  13. #13
    Membre habitué
    Ah oui effectivement si je lis mal... Enfin, ça ne marche toujours pas. En fait ça ne copie même plus rien du tout dans la feuille Excel, j'y comprends rien

  14. #14
    Membre habitué
    Stop arrêtez tout, cette fois ci c'est la bonne ! J'ai simplement enlevé la boucle à la fin de la fonction "ProcessThisItem", ça donne ça tout simplement :

    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 ProcessThisItem(objitem As Object)
    '---------------------------------------------------------------------------------------
    ' Procedure : ProcessThisItem
    ' Author    : Oliv
    ' Date      : 12/02/2016
    ' Purpose   :
    '---------------------------------------------------------------------------------------
    '
        If objitem.Class = olMail Then
            Dim MyMail As Outlook.MailItem
            Set MyMail = objitem
     
        'ici le code
     
        Cells(B, 1) = MyMail.Subject
        Cells(B, 2) = MyMail.ReceivedTime
        Cells(B, 3) = MyMail.SenderEmailAddress
        B = B + 1
     
        End If
     
    End Sub


    Merci beaucoup pour ton aide et ta patience Oliv !

  15. #15
    Expert éminent
    ah oui effectivement, je l'avais pas vue celle là !, dans ProcessThisItem, on travaille avec 1 mail en particulier

  16. #16
    Membre habitué
    Je l'avais ajouté pour tester une autre solution, et comme tu n'avais pas fait de remarque dessus je pensais que c'était juste... Je me suis trompée C'est noté sur le fonctionnement en tout cas !

###raw>template_hook.ano_emploi###