archiver dans repertoire selon restrictions jour et temps

[CAPRI_456]

Bonjour le Forum,,,,

j'ai un un archivage à réaliser dans un répertoire,
fonction du jour, de l'heure à laquelle je reçois un mail dans outlook 2003
(ce module enclenchera par la suite une procédure dans excel 2003: autre module)

je dois donc comparer en VBA :
- jour et heure de réception de MonMail au format "dd/mm/yyyy hh:mm:ss" avec :
A-- si arrivent entre 06.00 h du jour en cours AddDate("h,6,today) et 06.00 h du jour suivant AddDate("h,30,today)soit , ils sont stockés dans le répertoire du jour en cours
B-- si arrivent entre 00.00 h AddDate("h,0,today) et 06.00 h AddDate("h,0,today) du jour en cours

Le point A fonctionne
Le point B : je n'y arrive pas ....
comment introduire cela en utilisant JAPREC (définition des restrictions)
Merci pour votre aide

CAPRI_456

Ci-joint mon code dans outlook 2003
Je poste ici, car tout compte fait, le même code est applicable au niveau d'EXCEL 2003 pour archiver dans des répertoires

' 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

 

[CAPRI_456]

Re : archiver dans repertoire selon restrictions jour et temps

Bonsoir le Forum, je cherche toujours une solution,

Malgré mes nouvelles tentatives , je parviens à archiver dans les répertoires si les mails reçus sont
1er cas : entre 06:00 h et 24:00 h
Par contre je n'arrive pas s'ils sont
2ème cas : entre 00:00 h et 06:00 h

Mes répertoires se créent pour la journee en cours ( JA) et pour le jour d'avant (JAPREC) et je parviens à y classer les mails reçus dans le 1er cas mais pas dans le 2ème cas

Voici mon code adapté dans un module EXCEL2003 :
-j'ai crée deux chemins pour le classement dans les répertoires
- j'ai crée un rupture pour ma journée :
--- JAD à JARUPT doivent reçevoir les mails de 00 à 06 h
--- JARUPT à JAF doivent reçevoir les maisl de 06 à 24 h

Ici j'ai introduit quelques données pour le test sans devoir agir avec OUTLOOK 2003 . A tester dans le module1 du classeur joint:

MonMailReceivedTime = "20-05-2009 00:08:23"
JAD = "20-05-2009 00:00:00"
JARUPT = "20-05-2009 06:00:00"
JAF = "20-05-2009 24:00:00"

est-ce dû à un problème de formattage des dates ??

Merci pour votre aide

Voir code dans le module 1 joint dans un classeur XLS

CAPRI_456