Supprimer pièce jointe d'un fichier outlook en vbs

Supprimer pièce jointe d'un fichier outlook en vbs - VB/VBA/VBS - Programmation

Marsh Posté le 17-06-2008 à 11:54:09    

bonjour,
 
Donc voici ce que je souhaiterai faire :  
 
recupérer les pièces jointes de mes message outlook ( Cela je l'effectue deja )
Ensuite je voudrai garder le message dans Outlook tout en supprimer le fichiers joint et en rajoutant un autre fichier qui me dit ou a été sauvegarder mon fichier joint auparavant
 
Voici mon code :
 

Code :
  1. cpt ="0"
  2. debut = Timer
  4. pst = InputBox ("Entrer le nom du fichier de dossiers personnels (pst)" & vbCrLf & _
  5. "Exemple : Dossiers personnels, Archive, Outlook Connector For Mdaemon", _
  6. "Sélection du dossiers personnels  - Service MCO" )
  8. dossier_outlook = InputBox ("Entrer le nom du dossier Outlook à extraire les fichiers joints" & vbCrLf & _
  9. "Exemple : Boîte de réception" & vbCrLf & "Seul les fichiers doc, docx, xls, xlsx, pdf seront extraits ", _
  10. "Sélection du dossier Outlook - Service MCO" )
  12. sous_dossier_outlook = InputBox ("Entrer le nom du sous-dossier Outlook à extraire les fichiers joints" & vbCrLf & _
  13. "Exemple : année 2007" & vbCrLf &  vbCrLf & "Si vous n'avez pas de sous-dossier, cliquer sur OK ou ANNULER", _
  14. "Sélection du sous-dossier Outlook - Service MCO" )
  16. Target_Folder = InputBox ("Entrer le chemin complet du répertoire de destination (il doit être créé préalablement)" & vbCrLf & "exemple : c:\mailbox\extract\", _
  17. "Choix du répertoire cible – Service MCO" )
  20. Set oOutLookObject = Createobject("Outlook.Application" )
  21. Set objFolder = oOutLookObject.GetNameSpace("MAPI" ).Folders(pst)
  22. Set objFolder = objFolder.Folders(dossier_outlook)
  23. If Not sous_dossier_outlook = False Then
  24. If Not sous_dossier_outlook = "" Then
  25.  Set objFolder = objFolder.Folders(sous_dossier_outlook)
  26. End If
  27. End IF
  28. Set objFSO = CreateObject("Scripting.FileSystemObject" )
  29. Set objLog = objFSO.CreateTextFile(Target_Folder & dossier_outlook & "_" &  sous_dossier_outlook & "_log.txt" )
  30. Set objShell = WScript.CreateObject("WScript.Shell" )
  31. objShell.Run "Net Stop Beep"
  33. objLog.WriteLine  "N°de fichier extrait |  Date de  reception | expéditeur  | Sujet du message | nom de la pièce jointe"
  34. objLog.WriteLine  "____________________________________________________________________________________________________"
  37. For Each objMail In objFolder.Items
  38.     If objMail.attachments.Count >0 Then
  39. On Error Resume Next
  40.         For i = 1 To objMail.attachments.Count
  41.              FichierJoint=""
  42.              Set FichierJoint = objMail.attachments.Item(i)
  43.  TypeFichier = Split(FichierJoint.DisplayName,"." )(1)
  46.   If TypeFichier = "doc" Or TypeFichier = "pdf" Or TypeFichier = "xls" Or TypeFichier = "docx" Or TypeFichier = "xlsx" Then
  47.    expediteur = Split(objMail.SenderName,"@" )(0)
  48.    mois = Split(Split(objMail.ReceivedTime," " )(0),"/" )(1)
  49.    annee = Split(Split(objMail.ReceivedTime," " )(0),"/" )(2)
  50.    FichierExtrait = annee & mois &"_"& expediteur &"_"& FichierJoint.DisplayName
  51.                FichierJoint.SaveAsFile Target_Folder & FichierExtrait
  52.    objLog.WriteLine  cpt & " | " & objMail.ReceivedTime & " | " & objMail.SenderName & " | " & objMail.Subject & " | " & FichierJoint.DisplayName
  53.    cpt = cpt + 1
  55.    objMail.Delete()
  57.   End If
  58. Next
  60.     End If
  61. Next
  63. If cpt > 0 Then
  64. Fin = Timer
  65. Duree = (Fix(Fin))-(Fix(Debut))
  66. MsgBox "Les fichiers joints ont été extrait" & vbCrLf & _
  67.  "Merci de Consulter le fichier " & vbCrLf & _
  68.  Target_Folder & dossier_outlook & "_" &  sous_dossier_outlook & "_log.txt" & vbCrLf &_
  69.  "Et de supprimer les messages concernés dans votre messagerie." & vbCrLf & _
  70.  "Durée d'exécution du script : " & Duree & " secondes" _
  71.  , vbOKOnly + vbInformation, "Extraction terminée - Service MCO"
  72. End If


 
Donc ici je sauvegarde la piece joint en la renomant et j'arrive a supprime le mail, mais je voudrai garder donc juste le corp du message
 
Merci d'avance

Reply

Marsh Posté le 17-06-2008 à 11:54:09   

Reply

Sujets relatifs:

Leave a Replay

Make sure you enter the(*)required information where indicate.HTML code is not allowed