Discussion :

[STOUPI]

Bonjour,
Est-il possible de récupérer des messages reçus dans outlook pour les utiliser dans Access (stockage en table par exemple), tout en conservant leur mise en forme.
Merci de votre aide.

[User]

Bonjour,

Voila comment je procède pour récupérer les emails reçus :

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
    'gestion des erreurs
    On Error GoTo err_RecupererMessagesRecus
 
    'déclaration des variables de travail
    Dim olkapp As Outlook.Application
    Dim olknamespace As Object
    Dim objOLfolder As Outlook.MAPIFolder
    Dim olkItem As Object
    Dim i As Long
    Dim oRst2 As DAO.Recordset
    Dim itms As Outlook.Items
 
    DoCmd.Hourglass True
 
       If Not IsOutLookRunning() Then
          Dim oShell As Object
          Set oShell = CreateObject("WScript.Shell")
          oShell.Run "outlook"
          Set oShell = Nothing
       End If
 
    'ouverture de l'object outlook
 
    Set olkapp = CreateObject("Outlook.application")
    Set olknamespace = olkapp.GetNamespace("MAPI")
 
    Set oRst2 = CurrentDb.OpenRecordset("T_InBox", dbOpenDynaset)
 
    'ouverture des dossiers de mails
    Set olMnfolder = olknamespace.Folders("adresse@gmail.com")
    Set objOLfolder = olMnfolder.Folders("Boîte de réception")
 
    'informations sur le nombre de mails trouvés
 
    'aucun mail n'a été trouvé ? => on sort !
       If objOLfolder.Items.Count = 0 Then
          DoCmd.Hourglass False
          Exit Function
       End If
 
       Set itms = objOLfolder.Items
 
          For i = 1 To itms.Count
             Set olkItem = itms(i)
             If TypeName(olkItem) = "MailItem" Then
                 oRst2.FindFirst "IdEmail='" & olkItem.EntryID & "'"
                   If oRst2.NoMatch Then
                      oRst2.AddNew
                      oRst2!IdEmail = olkItem.EntryID
                      oRst2!Objet = Nz(olkItem.Subject, "")
                      oRst2!Message = Nz(Replace(olkItem.Body, vbCrLf & vbCrLf, vbCrLf), "")
                      oRst2!Expediteur = Nz(olkItem.Sender, "")
                      oRst2!EmailExpediteur = Nz(olkItem.SenderEmailAddress, "")
                      oRst2!DateHeureEmail = Nz(olkItem.ReceivedTime, "")
 
                      oRst2.Update
                    End If
                End If
             Set olkItem = Nothing
          Next i
 
    'fermeture et libération des objets
 
    Set itms = Nothing
 
    Set objOLfolder = Nothing
    Set objMnfolder = Nothing
 
    Set olknamespace = Nothing
 
    'olkapp.Quit
    Set olkapp = Nothing
 
    'oRst1.Close
    'Set oRst1 = Nothing
 
    oRst2.Close
    Set oRst2 = Nothing
 
    'fermeture normale
    DoCmd.Hourglass False
    MsgBox ("Messages reçus récupérés !")
 
    Exit Function
 
    'en cas d'erreur
err_RecupererMessagesRecus:
    DoCmd.Hourglass False
    MsgBox ("L'erreur suivante a eu lieue : " & vbCrLf & Err.Description)

Comme tu peux le remarquer, le contenu du message (olkItem.Body) c'est juste du texte, les sauts de lignes sont bien récupérés par contre la mise en forme...


Sinon, tu peux créer un bouton sous Access qui ouvre ton email reçu dans outlook, comme ça tu vois la mise en forme.

Pour cela, il faut utiliser cette fonction :

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
Function DisplayEmailIn(IdEmail As String) As Boolean
 
    'gestion des erreurs
    On Error GoTo err_DisplayEmailIn
 
    'déclaration des variables de travail
    Dim olkapp As Outlook.Application
    Dim olknamespace As Object
    Dim objOLfolder As Outlook.MAPIFolder
    Dim itms As Outlook.Items
    Dim olkItem As Outlook.MailItem
    Dim i As Long
 
       If Not IsOutLookRunning() Then
          Dim oShell As Object
          Set oShell = CreateObject("WScript.Shell")
          oShell.Run "outlook"
          Set oShell = Nothing
       End If
 
    'ouverture de l'object outlook
 
    Set olkapp = CreateObject("Outlook.application")
    Set olknamespace = olkapp.GetNamespace("MAPI")
 
    'ouverture des dossiers de mails
    Set olMnfolder = olknamespace.Folders("adresse@gmail.com")
    Set objOLfolder = olMnfolder.Folders("Boîte de réception")
 
          Set olkItem = olknamespace.GetItemFromID(IdEmail, objOLfolder.StoreID)
 
             If Not (olkItem Is Nothing) Then
                olkItem.Display
             End If
 
          Set olkItem = Nothing
 
    'fermeture et libération des objets
 
    Set objOLfolder = Nothing
    Set objMnfolder = Nothing
 
    Set olknamespace = Nothing
    Set olkapp = Nothing
 
    Exit Function
 
    'en cas d'erreur
err_DisplayEmailIn:
    DoCmd.Hourglass False
    MsgBox ("L'erreur suivante a eu lieue : " & vbCrLf & Err.Description)
 
End Function

Que tu appelles comme ceci :

Code :

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

1
2
3
4
Private Sub CmdEmailOutLook_Click()
DisplayEmailIn (Me.IdEmail)
 
End Sub

A+