Pb annulation tache VBA outlook.

Bonjour,

J'ai repris un script pour sauvegarder une selection de mail dans un répertoire à choisir lors de l'execution de la tache.Le pb c'est que lorsque la fenetre explorer s'ouvre j'ai 3 onglets (creer nouveau dossier/ok/annuler).
Lorsque je clic sur annuler la tache s'execute sur la racine de c:\.
Hors je souhaiterai annuler la tache qund je clic sur annuler.Voici le code.



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

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

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