Sub Test()
'Kill "C:\Documents and Settings\RC1194\Desktop\test\test1\**"
Outlook_Archive = "Boîte aux lettres - Anthony (LY FR)"
Outlook_Folder = "Boîte de réception"
Outlook_SubFolder1 = "TMA"
Outlook_SubFolder2 = ""
Outlook_SubFolder3 = ""
Subject_InStr = ""
Get_All_Files = True
Delete_Mail = False
Target_Folder = "N:\Historisation\Fichiers Tma Share\"
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*"
End Sub