Vba intégration d'une date de lancement de la macro

[anthooooony]

Bonjour à tous !

Je cherche de l'aide sur une macro qui envoie tous les fichiers joints d'un dossier vers un disque local.

J'ai cette macro qui est très bien ! qui marche très très bien ! mais j'ai ce problème ! la taille de ma boite aux lettres qui limité.

En faite, je reçois chaque matin des emails avec chacun un fichier joint. Fichier qui va de 80ko à 700Ko. Ce dossier me prend déjà 150 Mo et 600 emails. J'ai deja fait une demande d augmentation de quota mais deja caduc
Cette macro reprend par défaut touuuut les fichiers présents dans le dossier "histo chargés". Entre autre, si j'enleve les mails il me copiera plus rien dans mon disque local.

Est-il possible de faire integrer dans une variable la date du dernier export? Comme ça il ne recupererait pas les données avant cette date(je pourrais donc effacer les données) et si je pars en vacances 15 jours il recupererait les 15 derniers jours.

En grand merci de votre aide !!

Anthooooony

Sub retardrelances()
'Kill "C:\Documents and Settings\RC1194\Desktop\test\test1\**"
Outlook_Archive = "Boîte aux lettres - Anthony (COFELY FR)"
Outlook_Folder = "Boîte de réception"
Outlook_SubFolder1 = "Histo chargés"
Outlook_SubFolder2 = ""
Outlook_SubFolder3 = ""

Subject_InStr = ""
Get_All_Files = True
Delete_Mail = False

Target_Folder = "N:\Historisation\Fichiers Retard Relance\"
Target_File_Name = ""
 
 Log_File_Long_Name = "Log Yohann"
'Shell ("C:\Documents and Settings\RC1194\Desktop\test\TEST\Test appli\TEST batch trois macros.bat")
'---------------------------------
' DO NOT CHANGE THE FOLLOWING CODE ReceivedTime &
'---------------------------------

cpt = 0
Set objOutlook = CreateObject("Outlook.Application")
Set objFolder = objOutlook.GetNamespace("MAPI").Folders(Outlook_Archive)

On Error Resume Next
For i = 0 To 3
Select Case i
Case 0
If Not Outlook_Folder = "" Then
Set objFolder = objFolder.Folders(Outlook_Folder)
Else
Exit For
End If
Case 1
If Not Outlook_SubFolder1 = "" Then
Set objFolder = objFolder.Folders(Outlook_SubFolder1)
Else
Exit For
End If
Case 2
If Not Outlook_SubFolder2 = "" Then
Set objFolder = objFolder.Folders(Outlook_SubFolder2)
Else
Exit For
End If
Case 3
If Not Outlook_SubFolder3 = "" Then
Set objFolder = objFolder.Folders(Outlook_SubFolder3)
Else
Exit For
End If
End Select
Next

If Not Err.Number = 0 Then
Exit Sub
End If
On Error GoTo 0

Set objItems = objFolder.Items
For mailIndex = objItems.Count To 1 Step -1
Set objMailItem = objItems.Item(mailIndex)
If objMailItem.Attachments.Count > 0 Then
If Not InStr(1, objMailItem.Subject, Subject_InStr, 1) = 0 Then
On Error Resume Next
If Get_All_Files Then
For i = 1 To objMailItem.Attachments.Count
Set PJ = objMailItem.Attachments.Item(i)
PJ.SaveAsFile Target_Folder & PJ.DisplayName
cpt = cpt + 1
Next
Else
Set PJ = objMailItem.Attachments.Item(1)
If Target_File_Name = "" Then Target_File_Name = ReceivedTime.Value & PJ.DisplayName
PJ.SaveAsFile Target_Folder & Target_File_Name
cpt = cpt + 1
End If
If Not Err.Number = 0 Then
Exit Sub
End If
On Error GoTo 0

If Delete_Mail Then objMailItem.Delete
End If
End If
Next

'Kill "C:\Documents and Settings\RC1194\Desktop\test\test1\*Copie*"
'Kill "C:\Documents and Settings\RC1194\Desktop\test\test1\*image001.jpg*"
'Kill "N:\Historisation\Fichiers Tma Share\*FMF*"
MsgBox "Macro terminée, les fichiers ont tous été copiés sur ton ordinateur"
End Sub

 

[anthooooony]

Re : Vba intégration d'une date de lancement de la macro

Bonjour

Personne n'aurait d'idée?

Je n'arrive pas à isoler les éléments déjà récupéré, si j'efface, je n'aurais plus rien vu qu'il efface et récupéré tout par défaut...

Merci

Anthooooony