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