[OL-365] Remplir un fichier Excel depuis des objets de mails Outlook

1 pièce(s) jointe(s)

Remplir un fichier Excel depuis des objets de mails Outlook

Bonjour,

Tous les matins je dois traiter une assez grande quantité de mails afin de remplir un fichier Excel. Pour vous donner un peu de contexte, ce sont des mails de sauvegarde et le fichier Excel nous permet de nous assurer que les sauvegarde se sont correctement effectuées.

Généralement, ils me suffit simplement de lire l'en-tête du mail pour savoir si la sauvegarde s'est correctement effectuée et reporter ensuite les infos dans le fichier Excel.
A titre d'exemple, les objets des mails ressemblent à ceci "[Nom de la société] - [Nom du serveur] - La sauvegarde s'est correctement effectuée"

Et voici à quoi ressemble le fichier Excel :

Pièce jointe 597551

Les tâches noires servent à cacher les noms des entreprises pour des raisons de confidentialités évidentes.

Donc en gros, dans le fichier Excel, chaque ligne contient le nom du serveur/tâche de sauvegarde du client et chaque colonne représente une date. Si la sauvegarde est bonne, on écrit OK sur la ligne concernée et à la bonne date.

J'avais pensé à faire un script VBA qui lirait chaque ligne de la boite de réception au lancement et qui procèderait avec des "if" dans le genre :
Code:

1 2 3 4 5 if (en-tête == "[nom exact de l'objet d'un mail de sauvegarde]") { Ecrire OK aux bonnes coordonnées dans le fichier Excel }
et continuer ainsi de suite pour chaque mail de sauvegarde, ce qui impliquerait de faire un "if" pour chaque mail de sauvegarde qu'on est sensé recevoir. Ce serait long et chronophage mais pour l'instant je ne vois que ça et le temps ainsi gagné par la suite serait considérable pour moi.

Le problème réside dans le fait que je n'ai pas vraiment d'idée pour gérer la date (et donc écrire dans la bonne colonne) et surtout je n'ai jamais fait de VBA de ma vie, je ne sais rien de la syntaxe, je ne sais pas si c'est possible de lier Outlook à un fichier Excel déjà existant et je n'ai trouvé que très peu d'infos sur internet concernant, déjà le VBA, et ensuite sur ce que je veux faire, à vrai dire je ne sais même pas si c'est réalisable…

Enfin bref j'aurais besoin de conseils pour ce projet, je vous avoue que pouvoir automatiser cette tâche m'enlèverait une bonne épine du pied tous les matins.

Merci :)

Citation:

Envoyé par trestresdebutant

Bonjour,

Si vous ne connaissez pas VBA, commencer par Outlook n'est pas le plus simple.
En ce qui concerne le rapatriement des messages sur Excel, j'utilise cette procédure créée par Oliv (:coucou:).
Dans cette configuration, il vous faudra pointer le répertoire à récupérer.
Les caractères ' placés en tête de ligne de code servent à neutraliser le code. Dans cette version, je ne récupère que l'objet du mail et la date.

Code:

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
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
 
Sub ExportFolderItemsToExcel()
'---------------------------------------------------------------------------------------
' Procedure : ExportFolderItemsToExcel
' Author    : Oliv
' Date      : 10/11/2017
' Purpose   : export des informations d'Emails de la boite de réception vers excel
'-----------------------------------------------------------------------------------------
'
Dim oFolder As Object
Dim criteria
Dim oTable As Object
Dim I, oRow, R, arr
Dim Wk As Workbook
Dim Ws As Worksheet
Dim DerniereColonne As Long
 
Const olFolderInbox = 6
Const olUserItems = 0
 
Dim OL As Object
Dim Destination As Range
 
    On Error GoTo FinOutLook
 
 
    If UCase(Application) = "OUTLOOK" Then
        Set OL = Application
    Else
        Set OL = CreateObject("outlook.application")
    End If
 
    'Si on connait le nom
    'Set oFolder = OL.Session.GetDefaultFolder(olFolderInbox).Store.GetSearchFolders.Item("tout")
    'si on veut choisir
    Set oFolder = OL.Session.PickFolder
 
    Debug.Print oFolder.Name
 
    'Pour ne prendre que les EMAILS
    criteria = "[MessageClass]='IPM.Note' or [MessageClass]='IPM.Post'"
 
    'Pour tous les éléments
    'criteria = "[MessageClass]<>'zzz'"
 
 
    Set oTable = oFolder.GetTable(criteria, olUserItems)
   ' MsgBox oTable.GetRowCount
    On Error Resume Next
    With oTable.Columns
        .RemoveAll
        .Add ("Subject")
       ' .Add ("CreationTime")
       ' .Add ("LastModificationTime")
       ' .Add ("MessageClass")
        .Add ("ReceivedTime")
       ' .Add ("Senton")
       ' .Add ("Size")
       ' .Add ("To")
       ' .Add ("Cc")
       ' .Add ("Bcc")
       ' .Add ("Categories")
       ' .Add ("ConversationTopic")
       ' .Add ("ReceivedByName")
       ' .Add ("SenderName")
       ' .Add ("SenderEmailAddress")
       ' .Add ("Unread")
       ' .Add ("http://schemas.microsoft.com/mapi/proptag/0x0E1B000B")    'PR_HASATTACH
       ' .Add ("ConversationIndex")
       ' .Add ("http://schemas.microsoft.com/mapi/proptag/0x66700102")
       ' .Add ("http://schemas.microsoft.com/mapi/proptag/0x1000001F")    '="Body"
        ''.Add ("Sent") 'KO
        ''.Add ("Duration") 'KO
        ''.Add ("Type") 'KO
 
    End With
    'MsgBox oTable.GetRowCount
 
    If oTable.GetRowCount = 0 Then
      MsgBox "Aucun message dans la boite de messagerie !", vbInformation
      Exit Sub
    End If
 
    Set Wk = ActiveWorkbook
    Set Ws = Wk.Sheets("Mails")   ' Nom de l'onglet à adapter
    With Ws
         R = 11 '.Cells(.Rows.Count, 1).End(xlUp).Row + 1 'Chez moi les tableaux commencent toujours à la ligne 10
    End With
 
    'GoTo parcourir
    '     one row spanning several columns
    oTable.Sort "ReceivedTime", True
    arr = oTable.GetArray(oTable.GetRowCount)
 
    Set Destination = Ws.Range("a" & R)
    Set Destination = Destination.Resize(UBound(arr, 1) + 1 - LBound(arr, 1), UBound(arr, 2) + 1 - LBound(arr, 2))
 
    On Error Resume Next
    Destination.Value = arr
 
    If Err = 1004 Then GoTo parcourir
    'quand cela ne marche pas cela vient du format de la colonne destination
    On Error GoTo 0
    GoTo mef
 
    'AUTRE METHODE on écrit en parcourant les enregistrement et les colonnes
parcourir:
    'pour parcourir la table champs par champs
    oTable.MoveToStart
    Do Until (oTable.EndOfTable)
        On Error Resume Next
        Set oRow = oTable.GetNextRow()
        For I = 1 To oTable.Columns.Count
            'Debug.Print oRow("Body")
            Select Case I
                Case 2
                     Ws.Cells(R, I).Value = Format(oRow(oTable.Columns(I).Name), "mm/dd/yyyy") ' hh:mm:ss")
                Case Else
                     Ws.Cells(R, I).Value = oRow(oTable.Columns(I).Name)
 
            End Select
        Next I
        Set oRow = Nothing
 
        R = R + 1
    Loop
 
    GoTo mef
 
mef:
 
    'mise en forme
    With Ws
         With .Cells
          '  .AutoFilter
            .EntireColumn.AutoFit
         End With
 
         DerniereColonne = .Cells(10, .Columns.Count).End(xlToLeft).Column
         With .Range(.Cells(10, 1), .Cells(10, DerniereColonne)).Interior
              .Pattern = xlSolid
              .PatternColorIndex = xlAutomatic
              .Color = 65535
              .TintAndShade = 0
              .PatternTintAndShade = 0
              .Parent.Font.Bold = True
          End With
          .Cells.WrapText = False
          .Activate
 
    End With
 
 
 
    GoTo FinOutLook
 
FinOutLook:
 
 
 
    Set OL = Nothing
    Set Wk = Nothing
    Set Ws = Nothing
    Set oTable = Nothing
    Set oRow = Nothing
    Set Destination = Nothing
    Set ShListe = Nothing
 
    Exit Sub
 
End Sub

Si cette récupération fonctionne chez vous, il sera préférable d'émettre ensuite vos messages depuis le forum VBA Excel pour faire vos comparaisons entre vos deux onglets.

Hey ! Merci Eric pour la réponse super rapide ! Je m'en vais m'inspirer du code que tu m'as proposé dès que j'ai un peu de temps.

En tout cas merci de m'avoir aidé ! :D