Récupérer des informations dans le corps d'un mail Outlook

**fragglerick** · 26/02/2013, 22h07

Bonsoir,

je souhaiterais récupérer les informations dans le corps de mes messages Outlook qui sont tous formatés de la même façon:

...................................................................
Objet: Demande de dépannage
...................................................................

Bonjour,

Merci de bien vouloir intervenir :

Ville: Paris

Famille : Électroménager

Type : Lave linge

Description de la panne : Pompe vidange HS

Cordialement.
.......................................................................

J'ai bien récupérer ce code mais, en l'état, il m'exporte entièreté de tous mes mails

...
Que dois-je déclarer dans ce code pour exporter vers Excel les données souhaitées ?
Fichier Excel que je souhaite lier à la T_Intervention de ma BD.

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
Sub ExtractMessage()
 
Dim OLapp As Outlook.Application
Dim OLspace As Outlook.Namespace
Dim OLinbox As Outlook.MAPIFolder
Dim FileName As String
Dim Item As Object
Dim NoFile As Integer
 
Set OLapp = CreateObject("Outlook.application")
Set OLspace = OLapp.GetNamespace("MAPI")
Set OLinbox = OLspace.GetDefaultFolder(olFolderInbox)
 
NoFile = FreeFile
Open CurrentProject.Path & "\Message" & Messages & ".xls" For Append As #NoFile
 
For Each Item In OLinbox.Items
    Print #NoFile, Item.Body
Next Item
 
Close #NoFile
 
Set OLapp = Nothing
Set OLspace = Nothing
Set OLinbox = Nothing
 
End Sub

Merci à vous !

**tee_grandbois** · 27/02/2013, 00h06

Bonsoir,
Pour "filtrer" les messages à traiter, utilises ce code

Code :

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

1
2
3
4
5
For Each Item In OLinbox.Items
    If Item.Subject = "Demande de dépannage" Then
        Print #NoFile, Item.Body
    End If
Next Item

**fragglerick** · 28/02/2013, 18h12

Bonjour,

Merci d'avoir pris le temps de me répondre tee_grandbois...
Après avoir "bataillé" j'arrive enfin à faire tourner le code : merci

En fait j'ai oublié de préciser que, dans l'objet des mails, la date faisait suite à la "demande dépannage" , raison pour laquelle mon fichier .xls restait toujours vide.

D’où mes questions:
Sachant que la date est une variable, quelle est la "syntaxe" qui permet également de la récupérer ?
Enfin, comment faire pour que chaque "Mail" deviennent un enregistrement et que les données soient séparées par des champs dans ma feuille .xls ?
Est-ce que ce "traitement" peut se faire directement par ce code, ou bien faut-il coder directement sur le fichier .xls ?

Encore merci !

**tee_grandbois** · 05/03/2013, 00h12

Bonsoir,
le code actuel remplit un fichier texte (et pas un classeur) à partir du corps d'un message. Pour alimenter ton classeur, il faudra lire le fichier texte créé pour alimenter le classeur. Voici le code qui pourra le faire :

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
Sub ExtractMessage()
' Variable Outlook
Dim OLapp As Outlook.Application
Dim OLspace As Outlook.Namespace
Dim OLinbox As Outlook.MAPIFolder
Dim FileName As String
' ATTENTION : variable FileName non utilisée, variable Messages utilisée mais non déclarée et non alimentée
Dim Item As Object
' Variables Fichier Texte
Dim NoFile As Integer
Dim stTextInput As String
' Variables Fichier Excel
Dim xlApp       As Excel.Application
Dim xlSheet     As Excel.Worksheet
Dim xlBook      As Excel.Workbook
 
Set OLapp = CreateObject("Outlook.application")
Set OLspace = OLapp.GetNamespace("MAPI")
Set OLinbox = OLspace.GetDefaultFolder(olFolderInbox)
 
NoFile = FreeFile
Open CurrentProject.Path & "\Message" & Messages & ".txt" For Append As #NoFile
 
For Each Item In OLinbox.items
    If Left(Item.Subject, 27) = "Objet: Demande de dépannage" Then
        Print #NoFile, Item.Subject   ' la date est dans l'objet du mail
        Print #NoFile, Item.Body
    End If
Next Item
 
Close #NoFile
 
' On ferme et ré-ouvre le fichier texte pour la lecture
Open CurrentProject.Path & "\Message" & Messages & ".txt" For Input As #NoFile
' On crée un nouveau classeur
Set xlApp = CreateObject("Excel.Application")
Set xlBook = xlApp.Workbooks.Add
    xlBook.SaveAs CurrentProject.Path & "\Message" & Messages & ".xls"
' Pour un classeur existant, la syntaxe serait la suivante :
'Set xlBook = xlApp.Workbooks.Open(CurrentProject.Path & "\Message" & Messages & ".xls")
 
    Set xlSheet = xlBook.Sheets(1)
    xlSheet.Activate
    ' 1 création de l'entête de colonnes à remplacer par le bon nom des champs de la table
    xlSheet.Cells(1, 1) = "DateDemande"
    xlSheet.Cells(1, 2) = "Ville"
    xlSheet.Cells(1, 3) = "Famille"
    xlSheet.Cells(1, 4) = "Type"
    xlSheet.Cells(1, 5) = "Description"
 
    Do While Not EOF(NoFile)
       Line Input #1, stTextInput
 
    ' 2 Extraction de la date
 
       If Left(stTextInput, 27) = "Objet : Demande de dépannage" Then
            xlSheet.Cells(2, 1) = Mid(stTextInput, 29) ' à modifier car la position exacte de la date n'est pas connue
       End If
 
    ' 3 Extraction de la ville
       If Left(stTextInput, 6) = "Ville:" Then
            xlSheet.Cells(2, 2) = Trim(Mid(stTextInput, 7))
       End If
 
    ' 4 Extraction de la famille
       If Left(stTextInput, 9) = "Famille :" Then
            xlSheet.Cells(2, 3) = Trim(Mid(stTextInput, 10))
       End If
 
    ' 5 Extraction du type
       If Left(stTextInput, 6) = "Type :" Then
            xlSheet.Cells(2, 4) = Trim(Mid(stTextInput, 7))
       End If
 
    ' 6 Extraction de la description
       If Left(stTextInput, 25) = "Description de la panne :" Then
           xlSheet.Cells(2, 5) = Trim(Mid(stTextInput, 26))
       End If
 
    Loop
    Close #NoFile
 
    xlBook.Save
    xlBook.Close (True)
    xlApp.Quit
 
Set xlSheet = Nothing
Set xlBook = Nothing
Set xlApp = Nothing
 
Set OLapp = Nothing
Set OLspace = Nothing
Set OLinbox = Nothing
 
End Sub

Tu pourras ensuite faire une importation du classeur Excel dans ta base.

**fragglerick** · 05/03/2013, 17h32

Bonjour tee_grandbois

Merci infiniment pour ton aide c'est

J'arrive presque au résultat voulu mais persistent encore quelques zones d'ombres...

Pour quelle raison, si je ne supprime pas " Objet : Demande de dépannage"
Le fichier .txt reste vide ?

Quoi qu'il en soit ça fonctionne correctement comme ceci:

Code :

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

1
2
3
4
5
6
For Each Item In OLinbox.Items
    If Left(Item.Subject, 20) = "Demande de dépannage" Then
        Print #NoFile, Item.Subject
        Print #NoFile, Item.Body
    End If
Next Item

Tous mes messages sont soigneusements copiés dans le .txt, mais seule l’extraction du dernier message (position dans le .txt) est réalisée vers le .xls ? Soit une seule ligne copiée ?

Encore une fois Merci beaucoup !

**tee_grandbois** · 05/03/2013, 22h50

Bonsoir,

Pour quelle raison, si je ne supprime pas " Objet : Demande de dépannage"
Le fichier .txt reste vide ?

tu as corrigé toi même : "Objet" est l'invite du champ Object, donc il n'est pas dans l'objet du message

Tous mes messages sont soigneusements copiés dans le .txt, mais seule l’extraction du dernier message (position dans le .txt) est réalisée vers le .xls ? Soit une seule ligne copiée ?

effectivement le code ne traitait qu'un seul message, voici le code corrigé :

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
Sub ExtractMessage()
' Variable Outlook
Dim OLapp As Outlook.Application
Dim OLspace As Outlook.Namespace
Dim OLinbox As Outlook.MAPIFolder
Dim FileName As String
Dim Item As Object
' Variables Fichier Texte
Dim NoFile As Integer
Dim stTextInput As String
' Variables Fichier Excel
Dim xlApp       As Excel.Application
Dim xlSheet     As Excel.Worksheet
Dim xlBook      As Excel.Workbook
' Variable du traitement
Dim I As Integer
 
Set OLapp = CreateObject("Outlook.application")
Set OLspace = OLapp.GetNamespace("MAPI")
Set OLinbox = OLspace.GetDefaultFolder(olFolderInbox)
 
NoFile = FreeFile
Open CurrentProject.Path & "\Message" & Messages & ".txt" For Append As #NoFile
 
For Each Item In OLinbox.items
    If Left(Item.Subject, 20) = "Demande de dépannage" Then
        Print #NoFile, Item.Subject   ' la date est dans l'objet du mail
        Print #NoFile, Item.Body
    End If
Next Item
 
Close #NoFile
 
' On ferme et ré-ouvre le fichier texte pour la lecture
Open CurrentProject.Path & "\Message" & Messages & ".txt" For Input As #NoFile
' On crée un nouveau classeur
Set xlApp = CreateObject("Excel.Application")
Set xlBook = xlApp.Workbooks.Add
    xlBook.SaveAs CurrentProject.Path & "\Message" & Messages & ".xls"
' Pour un classeur existant, la syntaxe serait la suivante :
'Set xlBook = xlApp.Workbooks.Open(CurrentProject.Path & "\Message" & Messages & ".xls")
 
    Set xlSheet = xlBook.Sheets(1)
    xlSheet.Activate
    I = 1
    ' 1 création de l'entète de colonnes
    xlSheet.Cells(I, 1) = "Date"
    xlSheet.Cells(I, 2) = "Ville"
    xlSheet.Cells(I, 3) = "Famille"
    xlSheet.Cells(I, 4) = "Type"
    xlSheet.Cells(I, 5) = "Description"
 
    Do While Not EOF(NoFile)
       Line Input #1, stTextInput
 
    ' 2 Extraction de la date
       If Left(stTextInput, 20) = "Demande de dépannage" Then
    ' Ajout d'une nouvelle ligne dans le classeur
            I = I + 1
            xlSheet.Cells(I, 1) = Mid(stTextInput, 29) ' à modifier car la position exacte de la date n'est pas connue
       End If
 
    ' 3 Extraction de la ville
       If Left(stTextInput, 6) = "Ville:" Then
            xlSheet.Cells(I, 2) = Trim(Mid(stTextInput, 7))
       End If
 
    ' 4 Extraction de la famille
       If Left(stTextInput, 9) = "Famille :" Then
            xlSheet.Cells(I, 3) = Trim(Mid(stTextInput, 10))
       End If
 
    ' 5 Extraction du type
       If Left(stTextInput, 6) = "Type :" Then
            xlSheet.Cells(I, 4) = Trim(Mid(stTextInput, 7))
       End If
 
    ' 6 Extraction de la description
       If Left(stTextInput, 25) = "Description de la panne :" Then
           xlSheet.Cells(I, 5) = Trim(Mid(stTextInput, 26))
       End If
 
    Loop
    Close #NoFile
 
    xlBook.Save
    xlBook.Close (True)
    xlApp.Quit
 
Set xlSheet = Nothing
Set xlBook = Nothing
Set xlApp = Nothing
 
Set OLapp = Nothing
Set OLspace = Nothing
Set OLinbox = Nothing
 
End Sub

Si la structure des messages est toujours la même, ce code devrait fonctionner sans problème.

**fragglerick** · 06/03/2013, 14h44

Bonjour tee_grandbois,

Merci çà fonctionne !!!

Encore une question:

J'essaye de récupérer l'heure de réception des mails avec l'expression => Item.ReceivedTime

J'ai inséré une Msgbox dans le code pour m'assurer que l'heure remonte bien => OK
En revanche, je n'arrive pas à l'exporter vers .xls ...? L'entête à été préalablement renseignée dans le code.
Selon moi, les fonctions Left/Right ne pouvant être utilisées, j'ai essayé avec les chaines de caractères...En vain !

...J'y retourne ...

Merci !

**tee_grandbois** · 06/03/2013, 22h52

Bonsoir,
problème assez simple : tu dois remplacer ces 3 bouts de code au bon endroit :
1)

Code :

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

1
2
3
4
5
6
7
For Each Item In OLinbox.items
    If Left(Item.Subject, 20) = "Demande de dépannage" Then
        Print #NoFile, Item.Subject   ' la date est dans l'objet du mail
        Print #NoFile, "Heure réception : " & Format(Item.ReceivedTime, Time)   ' Date & heure de réception au format Heure
        Print #NoFile, Item.Body
    End If
Next Item

2)

Code :

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

1
2
3
4
5
6
7
    ' 1 création de l'entète de colonnes
    xlSheet.Cells(I, 1) = "Date"
    xlSheet.Cells(I, 2) = "Ville"
    xlSheet.Cells(I, 3) = "Famille"
    xlSheet.Cells(I, 4) = "Type"
    xlSheet.Cells(I, 5) = "Description"
    xlSheet.Cells(I, 6) = "HeureReception"

3)

Code :

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

1
2
3
4
    ' 7 Extraction heure de réception
       If Left(stTextInput, 18) = "Heure réception : " Then
            xlSheet.Cells(I, 6) = Trim(Mid(stTextInput, 19))
       End If

**fragglerick** · 07/03/2013, 22h58

Bonsoir !

Si je laisse l'expression tel quel, c'est l'heure système qui est remontée.
Est-ce normal ?

Code :

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

Print #NoFile, "Heure réception : " & Format(Item.ReceivedTime, Time)

En remplaçant "Time" par "hh:mm" tout est ok !

J'aurais bien tout un tas de questions à te soumettre mais je ne veux pas abuser..

Je n'ai plus qu'a éteindre la lumière en sortant sans oublier de te remercier une dernière fois

**tee_grandbois** · 07/03/2013, 23h19

Bonsoir,

En remplaçant "Time" par "hh:mm" tout est ok !

Bien vu ! mon format, c'était n'importe quoi, mais après une journée de travail je n'ai pas toujours les idées claires.

Récupérer des informations dans le corps d'un mail Outlook [AC-2007]

VBA Access

Discussions similaires

Partager

Partager