Supression Mail dans Outlook

AReS097 Messages postés 24 Date d'inscription mercredi 11 mars 2009 Statut Membre Dernière intervention 14 janvier 2021 - Modifié le 10 févr. 2020 à 16:22
vb95 Messages postés 3472 Date d'inscription samedi 11 janvier 2014 Statut Contributeur Dernière intervention 13 avril 2024 - 11 févr. 2020 à 23:13
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

vb95 Messages postés 3472 Date d'inscription samedi 11 janvier 2014 Statut Contributeur Dernière intervention 13 avril 2024 169
Modifié le 11 févr. 2020 à 23:15
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

0
Rejoignez-nous