lancement d'un macro à la réception d'un mail d'un expéditeur précis

anthooooony

XLDnaute Occasionnel
Bonjour

Je suis en train d'essayer d'automatiser le traitement d'un fichier que je reçois tt les jours en pièce jointe.
La macro ci dessous s exécute manuellement et amene les fichiers joints dans un endroit bien précis de mon disque dur.

Sauf qu'au lieu de le lancer manuellement je souhaiterais savoir s'il est possible de lui dire de se lancer au moment où il reçoit un mail d'un expéditeur précis? anthooooony@hotmail.com par exemple.
Auriez vous une piste ?

merci d'avance

anthooooony


Code:
Sub Extraction()

Outlook_Archive = "Boîte aux lettres - AA Anthony (BLABLA)"
Outlook_Folder = "Boîte de réception"
Outlook_SubFolder1 = "Test"
Outlook_SubFolder2 = ""
Outlook_SubFolder3 = ""

Subject_InStr = ""
Get_All_Files = True
Delete_Mail = False

Target_Folder = "C:\Documents and Settings\RC1194\Desktop\test\"
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
End Sub
 
Dernière édition:

Discussions similaires

Statistiques des forums

Discussions
312 493
Messages
2 088 956
Membres
103 990
dernier inscrit
lamiadebz