Bonjour,

J'ai récupéré un script vba d'oliv pour la sauvegarde de mes mails en .msg sur mon disque dur.

Le script s'exécute bien sauf que lorsque la fenêtre Explorer s'ouvre pour choisir l'endroit où stocker mes messages, (bouton Créer nouveau dossier/OK/Annuler/croix rouge).

Si j'annule par la croix ou par le bouton Annuler, et bien la tâche continue et me stocke le message à la racine de C:\. Donc comment rajouter la fonction :

Si aucun mail sélectionné = aucune sélection et si croix ou Annuler ont été cliqués, annuler la tâche.

Voici le script:

Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Public Enum vbConfigBrowse
    DirButtonCreateOKCancel = 0
    DirButtonCreateOKCancelTextBox = 16
    DirButtonCreateOKCancelInfo = 2500
    DirButtonOkCancelTextbox = 560
    DirButtonOkCancel = 550
    PrtButtonOkCancelTextbox = -1
End Enum
 
Public repertoire
 
Public Function BrowseAndCreate(Title As String, Optional Config As vbConfigBrowse = 0) As String
    Dim Shell As Variant, Folder As Variant
    Set Shell = CreateObject("Shell.Application")
    On Error Resume Next
    Set Folder = Shell.BrowseForFolder(Hwnd, Title, Config, "")
    BrowseAndCreate = Folder.Items.Item.Path
 
End Function
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
Sub sav_mail_Ei_as_msg(Optional objCurrentMessage As Object)
 
    If objCurrentMessage Is Nothing Then Set objCurrentMessage = ActiveInspector.CurrentItem
 
    NomExport = Format(objCurrentMessage.ReceivedTime, "DD_MM_YYYY") & "_" & objCurrentMessage.Subject
 
 
    PathNomExport = repertoire & "_" & Left(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace( _
    NomExport, "\", ""), "/", ""), ":", ""), "*", ""), "?", ""), "<", ""), ">", ""), "|", ""), ".", ""), """", ""), vbTab, ""), Chr(7), ""), 160) & ".msg"
 
       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
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
Sub export_mail()
 
    Dim objCurrentMessage As Object
    Dim MonOutlook As Outlook.Application
    Dim LeMail As Object
    Dim LesMails As Outlook.Selection
    Set MonOutlook = Outlook.Application
 
    Set LesMails = MonOutlook.ActiveExplorer.Selection
 
    repertoire = BrowseAndCreate("Sauvegarde") & "\"
    For Each LeMail In LesMails
 
 
    sav_mail_Ei_as_msg LeMail
 
    Next LeMail
 
    Set LesMails = Nothing
    MsgBox "Fin de traitement"
End Sub

Merci du coup de main.