[VBA] réception des informations d’email

Version imprimable

Bonjour
J’ai un petit problème si on peut dire avec la réception des informations à partir d’un email avec outlook
J’ai un exemple de réception qui marche :

Code:

1
2
3
4
5
6
7
8
9
marequete = "INSERT INTO BoiteDeRéception (SUJET,TO,ENVOYELE,RECULE,Body,Size,CC) 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(objOLfolder.Items(I).ReceivedTime), objOLfolder.Items(I).ReceivedTime, "") & "'" _
& ",'" & IIf(Not IsNull(objOLfolder.Items(I).Body), objOLfolder.Items(I).Body, "") & "'" _
& ",'" & IIf(Not IsNull(objOLfolder.Items(I).Size), objOLfolder.Items(I).Size, "") & "'" _
& ",'" & IIf(Not IsNull(objOLfolder.Items(I).CC), objOLfolder.Items(I).CC, "") & "'" _
& ");"

Les information son enregistre dans la table BoiteDeRéception

Mais si je veut le champ CCi et le champ de pièce jointe Attachments ca ne marche pas
Et voila mon code :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
marequete = "INSERT INTO BoiteDeRéception (SUJET,TO,ENVOYELE,RECULE,Body,Size,CC,CCi,Attachments) 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(objOLfolder.Items(I).ReceivedTime), objOLfolder.Items(I).ReceivedTime, "") & "'" _
& ",'" & IIf(Not IsNull(objOLfolder.Items(I).Body), objOLfolder.Items(I).Body, "") & "'" _
& ",'" & IIf(Not IsNull(objOLfolder.Items(I).Size), objOLfolder.Items(I).Size, "") & "'" _
& ",'" & IIf(Not IsNull(objOLfolder.Items(I).CC), objOLfolder.Items(I).CC, "") & "'" _
& ",'" & IIf(Not IsNull(objOLfolder.Items(I).BCC), objOLfolder.Items(I).BCC, "") & "'" _
& ",'" & IIf(Not IsNull(objOLfolder.Items(I).Attachments), objOLfolder.Items(I).Attachments, "") & "'" _
& ");"
DoCmd.RunSQL marequete

donc Comment récupère le champ de pièce jointe ,cci et aussi du l’expéditeur
Et merci d’avance :D :D :D :D

Pour le champ de l’expéditeur je les trouver
Donc mon code est :

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
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


Find = Chr(34)
repl = "'"
'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
'pour remplacer le caractère " dans le sujet par un espace ou le carctère '
nouvsujet = Replace(Replace(objOLfolder.Items(I).Subject, Find, repl), "'", " ")

marequete = "INSERT INTO BoiteDeRéception (SUJET,TO,ENVOYELE,RECULE,Body,Size,CC,De) 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(objOLfolder.Items(I).ReceivedTime), objOLfolder.Items(I).ReceivedTime, "") & "'" _
& ",'" & IIf(Not IsNull(objOLfolder.Items(I).Body), objOLfolder.Items(I).Body, "") & "'" _
& ",'" & IIf(Not IsNull(objOLfolder.Items(I).Size), objOLfolder.Items(I).Size, "") & "'" _
& ",'" & IIf(Not IsNull(objOLfolder.Items(I).CC), objOLfolder.Items(I).CC, "") & "'" _
& ",'" & IIf(Not IsNull(objOLfolder.Items(I).SenderEmailAddress), objOLfolder.Items(I).SenderEmailAddress, "") & "'" _
& ");"
'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

Mais il reste le le champ de pièce jointe
Si quelqu'un peut me donnez un peut d’aide sa sera un grand service de sa par merci merci d’avance:) :) :) :) :) 8-)

attachments .. est une collection... , il peu avoir plusieurs fichier en pieces jointes...

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
 
Dim stPJointes As String
 
For I = objOLfolder.Items.Count To 1 Step -1
For Each myatt In 
objOLfolder.Items(I).Attachments
  If stPJointes = "" Then
    stPJointes = myatt.FileName
  Else
   stPJointes = stPJointes & "," & myatt.FileName
  End If
Next
...
...
& ",'" & stPjointes & "'" _
& ");"

Je m’excuse pour le dérangement ; j’ai copier le code que tu ma donne et je les intégrer dans mon code .
Normalement quand j’exécuter mon code il y a deux messages :

Citation:

Access a trouvé : xx message dans votre boite de réception !
Citation:

Un programme essaie d’accéder aux adresse de …..

Puit les donnes sont enregistre dans la table.
Mais quand j’ai ajouter votre code il ma donne un notre message à la fin de ces deux message :

Citation:

L’erreur suivante a eu lieue :
Propriété ou méthode non gérée par cet objet

ce que j’ai penser que ce message du au type du champ attachement dans la table alors j’ai changer son type au mémo ,texte,Objet OLE et Lien hypertexte .
Mais le même problème !!!!!

Alors mon code est :

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
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 stPJointes As String  ‘j’ai ajouter ca  
Dim olkapp As Object
Dim olknamespace As Object
Dim objOLfolder As Outlook.MAPIFolder
Dim I As Integer
Dim K As Integer   ‘j’ai ajouter ca  
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



Find = Chr(34)
repl = "'"
'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

'le code pour enregistre les pièces jointes dans la table
For K = objOLfolder.Items.Count To 1 Step -1

For Each myatt In objOLfolder.Items(K).Attachments
  If stPJointes = "" Then
    stPJointes = myatt.FileName
  Else
   stPJointes = stPJointes & "," & myatt.FileName
  End If
Next

'pour remplacer le caractère " dans le sujet par un espace ou le carctère '
nouvsujet = Replace(Replace(objOLfolder.Items(I).Subject, Find, repl), "'", " ")

marequete = "INSERT INTO BoiteDeRéception (SUJET,TO,ENVOYELE,RECULE,Body,Size,CC,De,Attachments) 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(objOLfolder.Items(I).ReceivedTime), objOLfolder.Items(I).ReceivedTime, "") & "'" _
& ",'" & IIf(Not IsNull(objOLfolder.Items(I).Body), objOLfolder.Items(I).Body, "") & "'" _
& ",'" & IIf(Not IsNull(objOLfolder.Items(I).Size), objOLfolder.Items(I).Size, "") & "'" _
& ",'" & IIf(Not IsNull(objOLfolder.Items(I).CC), objOLfolder.Items(I).CC, "") & "'" _
& ",'" & IIf(Not IsNull(objOLfolder.Items(I).SenderEmailAddress), objOLfolder.Items(I).SenderEmailAddress, "") & "'" _
& ",'" & IIf(Not IsNull(objOLfolder.Items(I).stPJointes), objOLfolder.Items(I).stPJointes, "") & "'" _
& ");"

'le variable k est un variable pour les pieces jointes
Next K

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

Merci d’avance:oops: :oops: :D

26/09/2006, 07h44
SfJ5Rpw8

stpjointes et une variable texte pas une propriété de ton obj ......item ,supprime aussi el iff... voir la je t'ai mis les 2 derniéres "lignes" de ton instruction d'insertion dans base...

PS: Attention j'espére que tu as bien compris qu'avec ce code tu ne met pas les piéces jointes dans ta base mais seulement leur nom ... tu devrai peu-être archiver aussi ces piéces jointes ...?

Non je ne veut pas archiver les pièces jointes mais seulement avoir un lien pour le télécharger si c’est possible . comme Outlook !!
Pour le code je les corriger

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
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 stPJointes As String
Dim olkapp As Object
Dim olknamespace As Object
Dim objOLfolder As Outlook.MAPIFolder
Dim I As Integer
Dim marequete As String

DoCmd.SetWarnings False 'sinon il va te demander a chaque fois voulez vous supprimer
DoCmd.RunSQL "DELETE * FROM BoiteDeRéception;"
DoCmd.SetWarnings True 'remet l'affichage des messages d'erreurs

'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



Find = Chr(34)
repl = "'"
'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

'le code pour enregistre les pièces jointes dans la table

For Each myatt In objOLfolder.Items(I).Attachments
  If stPJointes = "" Then
    stPJointes = myatt.FileName
  Else
   stPJointes = stPJointes & "," & myatt.FileName
  End If
Next


'pour remplacer le caractère " dans le sujet par un espace ou le carctère '
nouvsujet = Replace(Replace(objOLfolder.Items(I).Subject, Find, repl), "'", " ")

marequete = "INSERT INTO BoiteDeRéception (SUJET,TO,ENVOYELE,RECULE,Body,Size,CC,De,Attachments) 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(objOLfolder.Items(I).ReceivedTime), objOLfolder.Items(I).ReceivedTime, "") & "'" _
& ",'" & IIf(Not IsNull(objOLfolder.Items(I).Body), objOLfolder.Items(I).Body, "") & "'" _
& ",'" & IIf(Not IsNull(objOLfolder.Items(I).Size), objOLfolder.Items(I).Size, "") & "'" _
& ",'" & IIf(Not IsNull(objOLfolder.Items(I).CC), objOLfolder.Items(I).CC, "") & "'" _
& ",'" & IIf(Not IsNull(objOLfolder.Items(I).SenderEmailAddress), objOLfolder.Items(I).SenderEmailAddress, "") & "'" _
& ",'" & IIf(Not IsNull(stPJointes), stPJointes, "") & "'" _
& ");"

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

Merci d’avance :P :P :oops:

26/09/2006, 19h13
SfJ5Rpw8

Citation:

Envoyé par jeha

Non je ne veut pas archiver les pièces jointes mais seulement avoir un lien pour le télécharger si c’est possible . comme Outlook !!
Pour le code je les corriger

Merci d’avance :P :P :oops:

sauf que da,s outlook ... une piéce jointe c'est une piéce jointe pas un lien vers un fichier le fichier fait partie du message donc si tu le sauve pas ailleur tu n'as dans ta base qu'un nom de fichier..
27/09/2006, 01h37
jeha

Donc comment on peut archiver ces pièces jointes dans ma base de donne ?:oops: :oops: :oops:
Merci d’avance:oops:
30/09/2006, 14h09
jeha

pas de repense pour ma question:( :( :( :( :oops:
03/10/2006, 17h55
jeha

Et bien bon jour mais amis
J’ai trouver la solution pour enregistre les pièces jointes d’un message email

ça c'est code d une boite de reception email

Citation:

Sub recupere_les_messages_outlook_dans_une_table()

'gestion des erreurs
On Error GoTo gere

'déclaration des variables de travail
Dim stPJointes As String
Dim olkapp As Object
Dim olknamespace As Object
Dim objOLfolder As Outlook.MAPIFolder
Dim I As Integer
Dim marequete As String
Dim Repertoire, NomDeFichierSurDisque, NomDeFichier As String
Dim code As String 'pour le chronoMesEmis
Dim messag As String
Dim Datee As String

DoCmd.SetWarnings False 'sinon il va te demander a chaque fois voulez vous supprimer
'DoCmd.RunSQL "DELETE * FROM BoiteDeRéception;"
DoCmd.SetWarnings True 'remet l'affichage des messages d'erreurs

'ouverture de l'object outlook
Set olkapp = CreateObject("Outlook.application")
Set olknamespace = olkapp.GetNamespace("MAPI")

'-----------------------------------------------------------

' Initialisation du reperetoire de sauvegarde
' ne pas oublier l'anti-slash à la fin du repertoire
Repertoire = "C:\message\"

'Inialisation des variables NomDeFichier, NomDeFichierSurDisque
NomDeFichierSurDisque = NomDeFichier = ""

'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

Find = Chr(34)
repl = "'"
'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

'pour enregistre les pièces jointes dans la table

For Each myatt In objOLfolder.Items(I).Attachments
If stPJointes = "" Then
stPJointes = myatt.FileName
NomDeFichierSurDisque = stPJointes
'------ pour l'enregistrement sur le disque ------
myatt.SaveAsFile Repertoire & NomDeFichierSurDisque
Else
NomDeFichierSurDisque = myatt.FileName
'------ pour l'enregistrement sur le disque ------
myatt.SaveAsFile Repertoire & NomDeFichierSurDisque
stPJointes = stPJointes & "," & myatt.FileName
End If
Next

'pour remplacer le caractère " dans le sujet par un espace ou le carctère '
nouvsujet = Replace(Replace(objOLfolder.Items(I).Subject, Find, repl), "'", " ")

'pour supprimer le reste du chronoMesEmis et avoir selement le code
code = objOLfolder.Items(I).CC

marequete = "INSERT INTO BoiteDeRéception (SUJET,TO,ENVOYELE,RECULE,Body,Size,CC,CCi,De,Attachments) 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(objOLfolder.Items(I).ReceivedTime), objOLfolder.Items(I).ReceivedTime, "") & "'" _
& ",'" & IIf(Not IsNull(objOLfolder.Items(I).Body), objOLfolder.Items(I).Body, "") & "'" _
& ",'" & IIf(Not IsNull(objOLfolder.Items(I).Size), objOLfolder.Items(I).Size, "") & "'" _
& ",'" & IIf(Not IsNull(FchronoMesEmis(code)), FchronoMesEmis(code), "") & "'" _
& ",'" & IIf(Not IsNull(objOLfolder.Items(I).BCC), objOLfolder.Items(I).BCC, "") & "'" _
& ",'" & IIf(Not IsNull(objOLfolder.Items(I).SenderEmailAddress), objOLfolder.Items(I).SenderEmailAddress, "") & "'" _
& ",'" & IIf(Not IsNull(stPJointes), stPJointes, "") & "'" _
& ");"

DoCmd.RunSQL marequete
stPJointes = ""
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

merci
03/10/2006, 18h29
SfJ5Rpw8

tu as donc décidé de sauver les piéces jointes sur le disque dur..? mais que mais tu dans ta base...? stPieceJointe ne contient que le nom du dernier ficier sauvé...? n'as tu pas un porblémes si plusieurs piéces jointes..?
08/10/2006, 01h55
jeha

Oui mais dans le champ de pièce jointe. si il y a plusieurs élément on a un point virgule entre les pièces jointes .
Donc on peut faire une fonction qui retourne une pièce jointe une par une