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
|
Sub Export_MailsOutlook()
'la référence Microsoft Outlook 9.0 Object Library est activée
Dim olApp As New Outlook.Application
Dim Cible As Outlook.MailItem
Dim Piece As Attachment
Dim dossierMail As Outlook.MAPIFolder
Dim destFolder
'nécessite d'activer la référence Microsoft DAO 3.6 Object Library
Dim dbs As Database
Dim CurrentDb As Database
Dim rs As DAO.Recordset
Dim QD As QueryDef
'ouverture d'Access
Set AccessApp = CreateObject("access.application")
AccessApp.OpenCurrentDatabase ("c:\[mondossier]\[mabase].mdb")
Set dbs = AccessApp.CurrentDb
Set olApp = New Outlook.Application
Set dossierMail = olApp.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).Folders("[dossier_source]")
Set destFolder = olApp.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).Folders("[dossier_destinataire]")
For Each Cible In dossierMail.Items
'remplacement des caractères interdits dans les noms de dossier Windows
Cible = Replace(Cible, "\", "", 1)
Cible = Replace(Cible, "/", "", 1)
Cible = Replace(Cible, ":", "", 1)
Cible = Replace(Cible, "*", "", 1)
Cible = Replace(Cible, "?", "", 1)
Cible = Replace(Cible, """", "", 1)
Cible = Replace(Cible, "<", "", 1)
Cible = Replace(Cible, ">", "", 1)
Cible = Replace(Cible, "|", "", 1)
' on appelle la fonction qui eclate le sujet et retourne les éléments nécessaires pour la base
ExploseSujet (Cible.Subject)
'on insert les éléments
dbs.Execute "INSERT INTO [matable] ([champ1], [champ2], [champ3], [champ4], [champ5], [champ6], [champ7], [champ8]) VALUES ('" & [valeur1] & "','" & [valeur2] & "','" & [valeur3] & "','" & [valeur4] & "','" & [valeur5] & "','" & [valeur6] & "','" & [valeur7] & "','" & [valeur8] & "');"
'on crée le chemin et le nom du dossier
CheminDossier = "F:\" & [valeur1] & "\" & [valeur2] & "\" & [valeur3] & "\" & [valeur4] & "\" & [valeur5] & "\"
Cible.SaveAs CheminDossier & Cible & ".msg", 3
'on déplace les mails dans un autre dossier "old"
Cible.Move (destFolder)
Next Cible
End Sub |
Partager