Opslaan als dialog in outlook

[ScriptGys]

Beste mensen,

Ik zit met iets waar ik niet uitkom. Namelijk het volgende.

Ik heb een macro (niet zelf geschreven maar van internet) die mails uit outlook netjes opslaat in een map. Enkel nu kan ik alleen een vaste map opgeven waarin de e-mails opgeslagen moeten worden. Graag wil een een save as dialog net als in word waar zelf een map opgegeven kan worden.

Hopelijk kunnen jullie mij helpen.

Dit is de code tot nu toe.

Sub VerplaatsHuidigeMailNaarMap()
Dim Item As Object
Dim Map As String
Dim BestandsNaam As String
Dim Mail As Outlook.MailItem

'Map = InputBox("Map:", "Bericht opslaan in...", CurDir)
Map = msoFileDialogSaveAs
'If CreateObject("Scripting.FileSystemObject").FolderExists(Map) Then
'    If Right(Map, 1) <> "\" Then
'        Map = Map + "\"
'    End If

For Each Item In Application.Explorers(1).Selection
If TypeName(Item) <> "MailItem" Then
    MsgBox "Selecteer eerst een mailbericht...", vbInformation, "Opdracht niet mogelijk"
    Exit Sub
End If

Set Mail = Item
BestandsNaam = Replace(Mail.Subject, ":", "")
BestandsNaam = Replace(BestandsNaam, "/", "")
BestandsNaam = Replace(BestandsNaam, "\", "")
BestandsNaam = Replace(BestandsNaam, "<", "")
BestandsNaam = Replace(BestandsNaam, ">", "")
BestandsNaam = Replace(BestandsNaam, ";", "")
If Dir(Map & BestandsNaam & ".msg") <> "" Then
    BestandsNaam = BestandsNaam & " " & Mail.ReceivedTime
    BestandsNaam = Replace(BestandsNaam, ":", "-")
End If
Mail.SaveAs Map & BestandsNaam & ".msg", olMSG
'Mail.Delete
Next
'End If
End Sub