doberman7578 | 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 :
- cpt ="0"
- debut = Timer
- pst = InputBox ("Entrer le nom du fichier de dossiers personnels (pst)" & vbCrLf & _
- "Exemple : Dossiers personnels, Archive, Outlook Connector For Mdaemon", _
- "Sélection du dossiers personnels - Service MCO" )
- dossier_outlook = InputBox ("Entrer le nom du dossier Outlook à extraire les fichiers joints" & vbCrLf & _
- "Exemple : Boîte de réception" & vbCrLf & "Seul les fichiers doc, docx, xls, xlsx, pdf seront extraits ", _
- "Sélection du dossier Outlook - Service MCO" )
- sous_dossier_outlook = InputBox ("Entrer le nom du sous-dossier Outlook à extraire les fichiers joints" & vbCrLf & _
- "Exemple : année 2007" & vbCrLf & vbCrLf & "Si vous n'avez pas de sous-dossier, cliquer sur OK ou ANNULER", _
- "Sélection du sous-dossier Outlook - Service MCO" )
- Target_Folder = InputBox ("Entrer le chemin complet du répertoire de destination (il doit être créé préalablement)" & vbCrLf & "exemple : c:\mailbox\extract\", _
- "Choix du répertoire cible – Service MCO" )
- Set oOutLookObject = Createobject("Outlook.Application" )
- Set objFolder = oOutLookObject.GetNameSpace("MAPI" ).Folders(pst)
- Set objFolder = objFolder.Folders(dossier_outlook)
- If Not sous_dossier_outlook = False Then
- If Not sous_dossier_outlook = "" Then
- Set objFolder = objFolder.Folders(sous_dossier_outlook)
- End If
- End IF
- Set objFSO = CreateObject("Scripting.FileSystemObject" )
- Set objLog = objFSO.CreateTextFile(Target_Folder & dossier_outlook & "_" & sous_dossier_outlook & "_log.txt" )
- Set objShell = WScript.CreateObject("WScript.Shell" )
- objShell.Run "Net Stop Beep"
- objLog.WriteLine "N°de fichier extrait | Date de reception | expéditeur | Sujet du message | nom de la pièce jointe"
- objLog.WriteLine "____________________________________________________________________________________________________"
- For Each objMail In objFolder.Items
- If objMail.attachments.Count >0 Then
- On Error Resume Next
- For i = 1 To objMail.attachments.Count
- FichierJoint=""
- Set FichierJoint = objMail.attachments.Item(i)
- TypeFichier = Split(FichierJoint.DisplayName,"." )(1)
- If TypeFichier = "doc" Or TypeFichier = "pdf" Or TypeFichier = "xls" Or TypeFichier = "docx" Or TypeFichier = "xlsx" Then
- expediteur = Split(objMail.SenderName,"@" )(0)
- mois = Split(Split(objMail.ReceivedTime," " )(0),"/" )(1)
- annee = Split(Split(objMail.ReceivedTime," " )(0),"/" )(2)
- FichierExtrait = annee & mois &"_"& expediteur &"_"& FichierJoint.DisplayName
- FichierJoint.SaveAsFile Target_Folder & FichierExtrait
- objLog.WriteLine cpt & " | " & objMail.ReceivedTime & " | " & objMail.SenderName & " | " & objMail.Subject & " | " & FichierJoint.DisplayName
- cpt = cpt + 1
- objMail.Delete()
- End If
- Next
- End If
- Next
- If cpt > 0 Then
- Fin = Timer
- Duree = (Fix(Fin))-(Fix(Debut))
- MsgBox "Les fichiers joints ont été extrait" & vbCrLf & _
- "Merci de Consulter le fichier " & vbCrLf & _
- Target_Folder & dossier_outlook & "_" & sous_dossier_outlook & "_log.txt" & vbCrLf &_
- "Et de supprimer les messages concernés dans votre messagerie." & vbCrLf & _
- "Durée d'exécution du script : " & Duree & " secondes" _
- , vbOKOnly + vbInformation, "Extraction terminée - Service MCO"
- 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
|
