Récupérer les mails Outlook dans une table Access

**THOGAL** · 27/08/2003, 18h48

allez ... rien que pour toi !

IL FAUT :
1 - Créer une table nomée TABLEMAIL avec pour champs :

SUJET=> string
TO=> string
ENVOYELE=>date
RECULE=>date

2 - et cocher la référence Ms Outlook object library dans Outils=> références.

3 - faire copier/coller de ce code dans un nouveau module :

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
 
Sub recupere_les_messages_outlook_dans_une_table()
 
    'gestion des erreurs
    On Error GoTo gere
 
    'déclaration des variables de travail
    Dim olkapp As Object
    Dim olknamespace As Object
    Dim objOLfolder As Outlook.MAPIFolder
    Dim i As Integer
    Dim marequete As String
    'ouverture de l'object outlook
    Set olkapp = CreateObject("Outlook.application")
    Set olknamespace = olkapp.GetNamespace("MAPI")
 
    'ouverture des dossiers de mails
    Set objOLfolder = olknamespace.GetDefaultFolder(olFolderInbox)
 
    'informations sur le nombre de mails trouvés
    MsgBox ("Access a trouvé : " & objOLfolder.Items.Count & " mail(s) dans votre boite de réception !")
 
    'aucun mail n'a été trouvé ? => on sort !
    If objOLfolder.Items.Count = 0 Then
        Exit Sub
    End If
 
    'on désactive les avertissements
    DoCmd.SetWarnings False
 
    'passage en revue des mails et écriture dans la table
    'des champs suivants SUJET,DESTINATAIRE,DATE ENVOI,DATE RECU
    For i = objOLfolder.Items.Count To 1 Step -1
        marequete = "INSERT INTO TABLEMAIL (SUJET,TO,ENVOYELE,RECULE) VALUES ('" _
        & IIf(Not IsNull(objOLfolder.Items(i).Subject), objOLfolder.Items(i).Subject, "") & "'" _
        & ",'" & IIf(Not IsNull(objOLfolder.Items(i).To), objOLfolder.Items(i).To, "") & "'" _
        & ",'" & IIf(Not IsNull(objOLfolder.Items(i).SentOn), objOLfolder.Items(i).SentOn, "") & "'" _
        & ",'" & IIf(Not IsNull(objOLfolder.Items(i).ReceivedTime), objOLfolder.Items(i).ReceivedTime, "") & "'" _
        & ");"
        'MsgBox ("ACCESS va éxécuter la requete suivante :" & vbCrLf & marequete)
        DoCmd.RunSQL marequete
    Next i
 
    'on réactive les avertissements
    DoCmd.SetWarnings True
 
    'fermeture des objets
    'et libération
    olkapp.Quit
    Set olkapp = Nothing
 
    'fermeture normale
    Exit Sub
 
    'en cas d'erreur
gere:
    MsgBox ("L'erreur suivante a eu lieue : " & vbCrLf & Err.Description)
    Exit Sub
 
End Sub
 
 
Sub essai()
recupere_les_messages_outlook_dans_une_table
End Sub

**olivier1971** · 02/07/2009, 15h09

Envoyé par THOGAL

allez ... rien que pour toi !

IL FAUT :
1 - Créer une table nomée TABLEMAIL avec pour champs :

SUJET=> string
TO=> string
ENVOYELE=>date
RECULE=>date

2 - et cocher la référence Ms Outlook object library dans Outils=> références.

3 - faire copier/coller de ce code dans un nouveau module :

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
 
Sub recupere_les_messages_outlook_dans_une_table()
 
    'gestion des erreurs
    On Error GoTo gere
 
    'déclaration des variables de travail
    Dim olkapp As Object
    Dim olknamespace As Object
    Dim objOLfolder As Outlook.MAPIFolder
    Dim i As Integer
    Dim marequete As String
    'ouverture de l'object outlook
    Set olkapp = CreateObject("Outlook.application")
    Set olknamespace = olkapp.GetNamespace("MAPI")
 
    'ouverture des dossiers de mails
    Set objOLfolder = olknamespace.GetDefaultFolder(olFolderInbox)
 
    'informations sur le nombre de mails trouvés
    MsgBox ("Access a trouvé : " & objOLfolder.Items.Count & " mail(s) dans votre boite de réception !")
 
    'aucun mail n'a été trouvé ? => on sort !
    If objOLfolder.Items.Count = 0 Then
        Exit Sub
    End If
 
    'on désactive les avertissements
    DoCmd.SetWarnings False
 
    'passage en revue des mails et écriture dans la table
    'des champs suivants SUJET,DESTINATAIRE,DATE ENVOI,DATE RECU
    For i = objOLfolder.Items.Count To 1 Step -1
        marequete = "INSERT INTO TABLEMAIL (SUJET,TO,ENVOYELE,RECULE) VALUES ('" _
        & IIf(Not IsNull(objOLfolder.Items(i).Subject), objOLfolder.Items(i).Subject, "") & "'" _
        & ",'" & IIf(Not IsNull(objOLfolder.Items(i).To), objOLfolder.Items(i).To, "") & "'" _
        & ",'" & IIf(Not IsNull(objOLfolder.Items(i).SentOn), objOLfolder.Items(i).SentOn, "") & "'" _
        & ",'" & IIf(Not IsNull(objOLfolder.Items(i).ReceivedTime), objOLfolder.Items(i).ReceivedTime, "") & "'" _
        & ");"
        'MsgBox ("ACCESS va éxécuter la requete suivante :" & vbCrLf & marequete)
        DoCmd.RunSQL marequete
    Next i
 
    'on réactive les avertissements
    DoCmd.SetWarnings True
 
    'fermeture des objets
    'et libération
    olkapp.Quit
    Set olkapp = Nothing
 
    'fermeture normale
    Exit Sub
 
    'en cas d'erreur
gere:
    MsgBox ("L'erreur suivante a eu lieue : " & vbCrLf & Err.Description)
    Exit Sub
 
End Sub
 
 
Sub essai()
recupere_les_messages_outlook_dans_une_table
End Sub

Mieux vaut tard que jamais et pour une fois que je contribue à quelque chose! Eh eh ouais le poste date quand même de 2003! Il m'a été très utile aujourd'hui!

: Merci à THOGAL

Pour le problème rencontré avec le simple quote (notre apostrophe) dans un sujet de mail par exemple: il y a effectivement la solution du replace ou bien tout simplement supprimer dans le code l'apostrophe par 2 guillemets comme ceci :

(je reprends que la partie à modifier du code ci-dessus)

Code :

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

1
2
3
4
5
6
marequete = "INSERT INTO TABLEMAIL (SUJET,TO,ENVOYELE,RECULE) VALUES (""" _
        & IIf(Not IsNull(objOLfolder.Items(i).Subject), objOLfolder.Items(i).Subject, "") & """" _
        & ",""" & IIf(Not IsNull(objOLfolder.Items(i).To), objOLfolder.Items(i).To, "") & """" _
        & ",""" & IIf(Not IsNull(objOLfolder.Items(i).SentOn), objOLfolder.Items(i).SentOn, "") & """" _
        & ",""" & IIf(Not IsNull(objOLfolder.Items(i).ReceivedTime), objOLfolder.Items(i).ReceivedTime, "") & """" _
        & ");"

Ca marche très bien aussi et en une seule passe

**botk62** · 03/07/2009, 15h56

bonjour

j'ai suivi avec interet tout ce post

et appliquer le code

j'ai ajouter le champ "body" dans la table

mais si on a des guillemet dans le corp du message outlook ca plante

une idée ??

**olivier1971** · 06/07/2009, 10h45

Envoyé par botk62

bonjour

j'ai suivi avec interet tout ce post

et appliquer le code

j'ai ajouter le champ "body" dans la table

mais si on a des guillemet dans le corp du message outlook ca plante

une idée ??

Effectivement çà pose problème lorsqu'il y a des guillemets...
Essaie cela , çà devrait marcher (j'ai ajouté le body du mail comme toi mais il faut que le champ de ta table s'appelle aussi body sinon renomme-le par le nom que tu lui as donné dans ta table INSERT.....RECULE,mon champ body de ma table) VALUES....

Code :

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

1
2
3
4
5
6
7
marequete = "INSERT INTO TABLEMAIL (SUJET,TO,ENVOYELE,RECULE,BODY) VALUES (""" _
        & IIf(Not IsNull(objOLfolder.Items(i).Subject), Replace(objOLfolder.Items(i).Subject, """", "''"), "") & """" _
        & ",""" & IIf(Not IsNull(objOLfolder.Items(i).To), Replace(objOLfolder.Items(i).To, """", "''"), "") & """" _
        & ",""" & IIf(Not IsNull(objOLfolder.Items(i).SentOn), Replace(objOLfolder.Items(i).SentOn, """", "''"), "") & """" _
        & ",""" & IIf(Not IsNull(objOLfolder.Items(i).ReceivedTime), Replace(objOLfolder.Items(i).ReceivedTime, """", "''"), "") & """" _
        & ",""" & IIf(Not IsNull(objOLfolder.Items(i).Body), Replace(objOLfolder.Items(i).Body, """", "''"), "") & """" _
        & ");"

**botk62** · 06/07/2009, 10h57

Formidable ça marche merci a toi

**zerrokooll** · 27/08/2003, 23h40

Bon, comme je suis rentrer chez moi, j'ai tester le code, cela marche bien evidement......

Mais, j'ai deux ou trois petites questions..... (bien evidement aussi...)

1°) pourrais m'expliquer ce bout de code, si j'ai bien compris, c'est la "declaration" des champs Outlook.

Code :

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

1
2
3
4
5
6
7
8
9
10
11
 
For i = objOLfolder.Items.Count To 1 Step -1 
        marequete = "INSERT INTO TABLEMAIL (SUJET,TO,ENVOYELE,RECULE) VALUES ('" _ 
        & IIf(Not IsNull(objOLfolder.Items(i).Subject), objOLfolder.Items(i).Subject, "") & "'" _ 
        & ",'" & IIf(Not IsNull(objOLfolder.Items(i).To), objOLfolder.Items(i).To, "") & "'" _ 
        & ",'" & IIf(Not IsNull(objOLfolder.Items(i).SentOn), objOLfolder.Items(i).SentOn, "") & "'" _ 
        & ",'" & IIf(Not IsNull(objOLfolder.Items(i).ReceivedTime), objOLfolder.Items(i).ReceivedTime, "") & "'" _ 
        & ");" 
        'MsgBox ("ACCESS va éxécuter la requete suivante :" & vbCrLf & marequete) 
        DoCmd.RunSQL marequete 
    Next i

2°) Ou puis je trouver le nom des champs de outlook au cas ou je voudrais en rajouter.

3°) Comment faire lorsque l'on gere plusieurs bal, car je me suis apercus qu'il ne gerer que la bal principale.

et encore merci pour ton aide...

**THOGAL** · 28/08/2003, 08h02

1 - détail d'une ligne :

Code :

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

marequete = "INSERT INTO TABLEMAIL (SUJET,TO,ENVOYELE,RECULE) VALUES

ca c'est le début de la requete SQl qui va ajouter un enregistrement dans la table , dans les champs SUJEt,TO,ENVOYELE,RECULE !

il va ajouter cette valeur :

Code :

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

IIf(Not IsNull(objOLfolder.Items(i).Subject), objOLfolder.Items(i).Subject, "")

=> si le sujet du mail en cours n'est pas null alors on ajoute le sujet du mail en cours dans la table sinon on ajoute "" (voir la fonction IIF() !

2 - explorateur d'objet (touche F2 dans ton code) et rechercher l'object MAILITEM => tu auras tous les champs disponibles !

3 - aucune idée ....

recherche justement dans l'explorateur d'objet si il existe une possibilité de changer le dossier mail !

**zerrokooll** · 28/08/2003, 10h59

Salut,

j'ai un petit souci, lorsque le sujet du mail comporte de guillemet, vb me renvoi le message suivant :

" L'erreur suivante a eu lieu :
Erreur de syntaxe (operateur absent) dans l'expression 'WINNT : affichage "L'installation a echoue"dans un script d'ouverture de session','MASCLEF, Raynald','28/08/2003 10:41:49','28/08/2003 10:41:52');"

en rouge, correspond au champs de mon mail.

pourquoi, j'ai l'impression qu'il prend les info des champs un peu comme des variables????

**THOGAL** · 28/08/2003, 11h05

pourquoi, j'ai l'impression qu'il prend les info des champs un peu comme des variables????

parce que c'est le cas !

tu peux utiliser le fonction replace() (qui focntionne qur access >97) pour remplacer le caractère " dans le sujet par un espace ou le carctère ' par exemple !

**zerrokooll** · 28/08/2003, 11h17

Si j'ai bien compris l'explication du bouquin " VB6 de Micro App", la syntaxe devrais etre quelque chose comme cela :

Code :

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

1
2
3
4
5
6
7
8
9
 
 
...
Chaine1=objOLfolder.Items.Subject
find="
repl='
 
Repfct=replace(Chaine1, find, repl)
...

est ce bon ?

**THOGAL** · 28/08/2003, 11h23

Code :

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

1
2
3
4
5
6
7
8
 
...
Chaine1=objOLfolder.Items(i).Subject 
find=chr(34) 
repl="'" 
 
nouveausujet=replace(Chaine1, find, repl) 
...

**zerrokooll** · 28/08/2003, 11h28

puis effectuer cette manipulation de code sans poser de pb :

Code :

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

1
2
3
4
5
6
7
8
9
 
 
... 
Chaine1=objOLfolder.Items(i).Subject 
find=chr(34) 
repl="'" 
 
objOLfolder.Items(i).Subject =replace(Chaine1, find, repl) 
...

**THOGAL** · 28/08/2003, 11h39

à non ! car si tu fais :

Code :

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

objOLfolder.Items(i).Subject =replace(Chaine1, find, repl)

tu vas carrément écrire dans le sujet dans outlook : plutot ca :

Code :

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

1
2
3
 
For i = objOLfolder.Items.Count To 1 Step -1 
nouvsujet = replace(objOLfolder.Items(i).Subject, find, repl)

et au lieu d'avoir :

Code :

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

1
2
 
        & IIf(Not IsNull(objOLfolder.Items(i).Subject), objOLfolder.Items(i).Subject, "") & "'" _

Tu as :

Code :

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

1
2
 
        & IIf(Not IsNull(nouvsujet), nouvsujet, "") & "'" _

tu comprends ?

**zerrokooll** · 28/08/2003, 11h56

si j'ai bien compris, au lieu d'aller chercher l'info "directement" dans outlook, tu la rapatrie, tu la modifie et ensuite tu 'linsert dans la table, en gros je pense que c'est cela.....

**THOGAL** · 28/08/2003, 12h06

c'est ca !

**zerrokooll** · 28/08/2003, 12h08

petite question, lorsque je lance la proc, il me dis que j'ai X mail, puis apres un msgbox me dis : "Index de la matrice hors limite".

Que cela signifie t'il ?

:

**THOGAL** · 28/08/2003, 13h05

Envoyé par zerrokooll

un msgbox me dis : "Index de la matrice hors limite".

Que cela signifie t'il ?

:

[troll on]
Que Néo est entré ? => bug de la matrice ?

[troll off]

fais voir ta procédure entière ! tout le code te ton module !

**zerrokooll** · 28/08/2003, 13h34

L'agent Smith va se charger de faire sortir, n'est ce pas agent Smith ?

Le voici :

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
 
 
Option Compare Database
Sub recupere_les_messages_outlook_dans_une_table()
 'gestion des erreurs
    On Error GoTo gere
 
    'déclaration des variables de travail
    Dim olkapp As Object
    Dim olknamespace As Object
    Dim objOLfolder As Outlook.MAPIFolder
    Dim i As Integer
    Dim marequete As String
    'ouverture de l'object outlook
    Set olkapp = CreateObject("Outlook.application")
    Set olknamespace = olkapp.GetNamespace("MAPI")
 
    'ouverture des dossiers de mails
    Set objOLfolder = olknamespace.GetDefaultFolder(olFolderInbox)
 
    'informations sur le nombre de mails trouvés
    MsgBox ("Access a trouvé : " & objOLfolder.Items.Count & " mail(s) dans votre boite de réception !")
 
    'aucun mail n'a été trouvé ? => on sort !
    If objOLfolder.Items.Count = 0 Then
        Exit Sub
    End If
 
    'on désactive les avertissements
    DoCmd.SetWarnings False
 
    'passage en revue des mails et écriture dans la table
    'des champs suivants SUJET,DESTINATAIRE,DATE ENVOI,DATE RECU
 
Chaine1 = objOLfolder.Items(i).Subject
    Find = Chr(34)
    repl = "'"
 
    For i = objOLfolder.Items.Count To 1 Step -1
    nouvsujet = Replace(objOLfolder.Items(i).Subject, Find, repl)
        marequete = "INSERT INTO TABLEMAIL (SUJET,TO,ENVOYELE,RECULE) VALUES ('" _
        & IIf(Not IsNull(nouvsujet), nouvsujet, "") & "'" _
        & ",'" & IIf(Not IsNull(objOLfolder.Items(i).To), objOLfolder.Items(i).To, "") & "'" _
        & ",'" & IIf(Not IsNull(objOLfolder.Items(i).SentOn), objOLfolder.Items(i).SentOn, "") & "'" _
        & IIf(Not IsNull(nouvsujet), nouvsujet, "") & "'" _
        & ");"
        'MsgBox ("ACCESS va éxécuter la requete suivante :" & vbCrLf & marequete)
        DoCmd.RunSQL marequete
    Next i
 
    'on réactive les avertissements
    DoCmd.SetWarnings True
 
    'fermeture des objets
    'et libération
    olkapp.Quit
    Set olkapp = Nothing
 
    'fermeture normale
    Exit Sub
 
    'en cas d'erreur
gere:
    MsgBox ("L'erreur suivante a eu lieue : " & vbCrLf & Err.Description)
    Exit Sub
 
End Sub
 
 
Sub essai()
recupere_les_messages_outlook_dans_une_table
 
End Sub

**THOGAL** · 28/08/2003, 13h44

problèmes d'une ligne en trop et oublie des déclarations (dim ..)

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
 
Option Compare Database 
Sub recupere_les_messages_outlook_dans_une_table() 
 'gestion des erreurs 
    On Error GoTo gere 
 
    'déclaration des variables de travail 
    Dim olkapp As Object 
    Dim olknamespace As Object 
    Dim objOLfolder As Outlook.MAPIFolder 
    Dim i As Integer 
    Dim marequete As String 
    'ouverture de l'object outlook 
    Set olkapp = CreateObject("Outlook.application") 
    Set olknamespace = olkapp.GetNamespace("MAPI") 
 
    'ouverture des dossiers de mails 
    Set objOLfolder = olknamespace.GetDefaultFolder(olFolderInbox) 
 
    'informations sur le nombre de mails trouvés 
    MsgBox ("Access a trouvé : " & objOLfolder.Items.Count & " mail(s) dans votre boite de réception !") 
 
    'aucun mail n'a été trouvé ? => on sort ! 
    If objOLfolder.Items.Count = 0 Then 
        Exit Sub 
    End If 
 
    'on désactive les avertissements 
    DoCmd.SetWarnings False 
 
    'passage en revue des mails et écriture dans la table 
    'des champs suivants SUJET,DESTINATAIRE,DATE ENVOI,DATE RECU 
 
dim nouvsujet as string
dim find as string
dim repl as string
 
    Find = Chr(34) 
    repl = "'" 
 
    For i = objOLfolder.Items.Count To 1 Step -1 
    nouvsujet = Replace(objOLfolder.Items(i).Subject, Find, repl) 
        marequete = "INSERT INTO TABLEMAIL (SUJET,TO,ENVOYELE,RECULE) VALUES ('" _ 
        & IIf(Not IsNull(nouvsujet), nouvsujet, "") & "'" _ 
        & ",'" & IIf(Not IsNull(objOLfolder.Items(i).To), objOLfolder.Items(i).To, "") & "'" _ 
        & ",'" & IIf(Not IsNull(objOLfolder.Items(i).SentOn), objOLfolder.Items(i).SentOn, "") & "'" _ 
        & IIf(Not IsNull(nouvsujet), nouvsujet, "") & "'" _ 
        & ");" 
        'MsgBox ("ACCESS va éxécuter la requete suivante :" & vbCrLf & marequete) 
        DoCmd.RunSQL marequete 
    Next i 
 
    'on réactive les avertissements 
    DoCmd.SetWarnings True 
 
    'fermeture des objets 
    'et libération 
    olkapp.Quit 
    Set olkapp = Nothing 
 
    'fermeture normale 
    Exit Sub 
 
    'en cas d'erreur 
gere: 
    MsgBox ("L'erreur suivante a eu lieue : " & vbCrLf & Err.Description) 
    Exit Sub 
 
End Sub 
 
 
Sub essai() 
recupere_les_messages_outlook_dans_une_table 
 
End Sub