archiver dans repertoire selon restrictions jour et temps

' OUTLOOK 2003
'+++++++++++++++++++++++++++++++++++++++++++++++++ ++++++++++++++++++++++++++++++++++++++++++++++++++ +++++++
'++++ A0 --- PARCOURIR INBOX à la recherche de MAILS
'++++ A1 ---- restriction : date/heure du mail
'++++ A2 ---- restriction : expéditeur du mail
'++++ A3 --- ARCHIVAGE DES MAILS après exécution des restrictions
'++++
'+++++++++++++++++++++++++++++++++++++++++++++++++ ++++++++++++++++++++++++++++++++++++++++++++++++++ +++++++
Sub ParcourirInbox()

' ************************ Déclaration des Objets et variables
Dim MonApply As Outlook.Application
Dim MonMail As Outlook.MailItem
Dim MonNSpace As Outlook.NameSpace
Dim FldDossier As Outlook.MAPIFolder
' ************************* Instance des Objets
Set MonApply = Outlook.Application 'Application Outlook
Set MonNSpace = MonApply.GetNamespace("MAPI") 'Banque MAPI
Set FldDossier = MonNSpace.GetDefaultFolder(olFolderInbox) 'boîte de réception

' ************************* Declare VARIABLES pour " JOUR D'ANALYSE..." Dim JourneeAnalyse As String
Dim today
Dim Jour As String, Mois As String, Annee As String
Annee = Year(Now)
Mois = Month(Now)
Jour = Day(Now)
today = Jour & "-" & Mois & "-" & Annee

' ************************ Définitions pour restrictions "période de réception"
JA= Format(DateAdd("h", 0, today), "dd-mm-yy") '
'JA = JourneeAnalyse
JAPREC= Format(DateAdd("h", -1, today), "dd-mm-yy")
'JAPREC = JourneeAnalyse moins 1h me donne le jour précédent
JAD= Format(DateAdd("h", 6, today), "dd/mm/yyyy hh:mm") 'JourneeAnalyseDebut
JAF= Format(DateAdd("h", 30, today), "dd/mm/yyyy hh:mm") 'JourneeAnalyseFin

'_________________________________________________ __________________________________________________ __
'++++++ A0 ---- PARCOURIR INBOX à la recherche de MAILS
'_________________________________________________ __________________________________________________ ___


For Each MonMail In FldDossier.Items

' ************************* définit date/heure/nom des mails d'origine présents inbox
NomMailOrigine = Format(MonMail.ReceivedTime, "dd-mm-yyyy hh-mm") & "_" & MonMail.Subject

'''========= définit le répertoire de sauvegarde
Dim Chemin8 As String
Chemin8 = "D:\Mails-reçus-T-" & JA
If Dir(Chemin8, vbDirectory + vbHidden) = "" Then MkDir Chemin8

'...si le DOSSIER n'existe pas,le créer
'ChDIr Chemin8

'_________________________________________________ __________________________________________________ ___
'A1 ========= RESTRICTION ::::::::::::::: fonction de la PERIODE DE RECEPTION + PERIODE D'ANALYSE
'_________________________________________________ __________________________________________________ ___
If Format(MonMail.ReceivedTime, "dd/mm/yyyy hh:mm") > Format(JAD, "dd/mm/yyyy hh:mm") And Format(MonMail.ReceivedTime, "dd/mm/yyyy hh:mm") < Format(JAF, "dd/mm/yyyy hh:mm") Then

'_________________________________________________ __________________________________________________ ___
'A3 ========= SAUVEGARDE DES MAILS SELON PERIODE D'ANALYSE
'_________________________________________________ __________________________________________________ ___

'===== ENREGISTRE chaque mail trouve dans un répertoire prédéfini : serveur D:\mails du......

MonMail.SaveAs Chemin8 & "\" & NomMailOrigine & ".MSG", olMsg

End If ' fin de la restriction sur période
'_________________________________________________ __________________________________________________ __
'++++++ A0 ---- PARCOURIR INBOX à la recherche de MAILS - suite de la boucle
'_________________________________________________ __________________________________________________ ___

Next MonMail ' recherche du mail suivant


'Vide des instances
Set MonApply = Nothing
Set MonNSpace = Nothing
Set FldDossier = Nothing
Set MonMail = Nothing

End Sub

Cliquez pour agrandir...