Rechercher pieces jointe .xls

[yo61]

Bonjour A tous et merci de me lire,

Sous Outlook 2007:

Je souhaites faire une recherche dans outlook dans ma boite de réception et dans les dossiers en dessous tous les mail contenant une pièce jointe .Xls

De la j aimerai pouvoir enregistrer automatiquement les pièces jointe dans un dossier en ajoutant au début du nom du fichier la date et heure de réception du mail ( 20110912-1410-.....xls) De même j aimerai enregistrer dans ce même dossier le le mail reçu en .pdf ou .doc

Probleme je ne maitrise pas du tout outlook

merci de votre aide

 

[yo61]

Re : Rechercher pieces jointe .xls

Bonjour;

J ai trouvé un code sur le net qui fait l extraction des pièces jointes dans outlook. Il a été crée par Philippe Heiz, 2003

Veuillez trouver le liens ci-dessous.

SCRIPT QUI PERMET D'EXTRAIRE DES PIÈCES JOINTES OUTLOOK ET DE LES ENREGISTRER extraire, outlook, office, pièces, jointes, Source N°29075 Visual Basic, VB6, VB.NET, VB 2005, VB

PS lisez les commentaire dessous pour utiliser le code.

 

[yo61]

Re : Rechercher pieces jointe .xls

Donc voici le code que j utilise , Il fonctionne bien sauf que je voudrais renommer les nom du fichier en y ajoutant la date et heure de réception du mail: J ai essayer avec ReceivedTime.Value mais ca fonctionne pas

quel qu un peux m aider



'***********************************************
'* This script gets Outlook email attachements *
'* and saves them into a specified directory. *
'*_____________________________________________*
'* By Philippe Heiz, 2003. *
'***********************************************

'---------------------------------
' CHANGE THE FOLLOWING SETTINGS
'---------------------------------



Sub Extraction()

Outlook_Archive = "Boîte aux lettres - Yohann LEMOINE"
Outlook_Folder = "Boîte de réception"
Outlook_SubFolder1 = "Dossiers de recherche"
Outlook_SubFolder2 = ""
Outlook_SubFolder3 = ""

Subject_InStr = ""
Get_All_Files = True
Delete_Mail = False

Target_Folder = "M:\LEMOINE\2B_REMISE DE PRIX FOURNISSEURS\HP spol\Pieces Jointes Outlook\"
Target_File_Name = ""

Log_File_Long_Name = "Log Yohann"

'---------------------------------
' 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