Supression Mail dans Outlook

Signaler
Messages postés
23
Date d'inscription
mercredi 11 mars 2009
Statut
Membre
Dernière intervention
10 février 2020
-
vb95
Messages postés
2064
Date d'inscription
samedi 11 janvier 2014
Statut
Contributeur
Dernière intervention
11 février 2020
-
Bonjour a tous,

J'ai créer une Macro VBA dans Outlook pour permettre au utilisateur de ranger leur Mail dans des dossier spécifique propre a notre process, et cette macro marche très bien.
Toutefois je n'arrive pas a résoudre un point qui me parait bête et pourtant je ne trouve pas de solution, c'est que une fois le mail enregistrer dans le dossier, je voudrais le mettre dans le dossier "Élément supprimée de Outlook", j'ai essayer plusieurs solution sans succès, pourriez vous me venir en aide ?

Merci par avance

Voici mon code :

__________
 Private Sub LanceSurSelection()
    Dim MonOutlook As Outlook.Application
    Dim LeMail As Object
    Dim LesMails As Outlook.Selection
    Set MonOutlook = Outlook.Application
 
    Set LesMails = MonOutlook.ActiveExplorer.Selection
 
    For Each LeMail In LesMails
        sav_mail_as_msg LeMail
    Next LeMail
  
    Set LesMails = Nothing
        
    'MsgBox "Fin de traitement"
End Sub


__________

Private Sub sav_mail_as_msg(Optional objCurrentMessage As Object)
 
    If objCurrentMessage Is Nothing Then Set objCurrentMessage = ActiveInspector.CurrentItem
 
    'Extraction et formatage de la date
    Annee = Mid(objCurrentMessage.CreationTime, 7, 4)
    Mois = Mid(objCurrentMessage.CreationTime, 4, 2)
    Jour = Mid(objCurrentMessage.CreationTime, 1, 2)
    Heure = Mid(objCurrentMessage.CreationTime, 12, 5)
    'Ici on construit le nom du fichier qui sera créé
    NomExport = Annee & Mois & Jour & "-" & Heure & "-" & MailSens & " - " & objCurrentMessage.Subject
 
    'Ici on défini le répertoire où l'enregistrer
    'repertoire = "c:\Cmc Interface\"
    'repertoire = BrowseForFolder("Choisissez la destination", SDossier(5, 0)) & "\"
 
    'Ici on supprime les caractères non autorisé dans les noms de fichiers
    PathNomExport = RepArchiv & Left(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace( _
    NomExport, "\", " "), "/", " "), ":", ""), "*", " "), "?", " "), "<", " "), ">", " "), "|", " "), ".", " "), """", ""), vbTab, ""), Chr(7), ""), 160) & ".msg"
 
    'Ici on vérifie que le fichier n'existe pas déjà sinon il serait écrasé
    n = 1
    MemPath = PathNomExport
    While Dir(PathNomExport) <> ""
        MsgBox "Le fichier " & vbCr & PathNomExport & vbCr & "existe déjà", vbInformation
        PathNomExport = Left(MemPath, Len(MemPath) - 4) & "(" & n & ")" & ".msg"
        n = n + 1
 
    Wend
    objCurrentMessage.SaveAs PathNomExport, OlSaveAsType.olMSG
 
End Sub

__________

1 réponse

Messages postés
2064
Date d'inscription
samedi 11 janvier 2014
Statut
Contributeur
Dernière intervention
11 février 2020
84
Bonjour
Peut-être une solution ici : https://codes-sources.commentcamarche.net/source/51693-outlook-effacer-par-code-les-mails-de-la-boite-des-elements-supprimes
Désolé je me suis précipité : tu ne veux pas les supprimer de la corbeille mais les mettre dans la corbeille