Opslaan mail in te selecteren map

Sub Mail_opslaan()
Dim Item As Object
  Dim Map As String
  Dim BestandsNaam As String
  Dim Mail As Outlook.MailItem
  
  Set Item = Application.Explorers(1).Selection(1)
  If TypeName(Item) <> "MailItem" Then
    MsgBox "Selecteer eerst een mailbericht...", vbInformation, "Opdracht niet mogelijk"
    Exit Sub
  End If
  Map = InputBox("Map en bestandsnaam:", "Bericht opslaan in...", "H:\Mijn Documenten")
  If CreateObject("Scripting.FileSystemObject").FolderExists(Map) Then
    If Right(Map, 1) <> "\" Then
      Map = Map + "\"
    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 = Format(Mail.ReceivedTime, "YYYYMMDD hhmm") & " " & BestandsNaam
        BestandsNaam = Replace(BestandsNaam, ":", "-")
    End If
    Mail.SaveAs Map & BestandsNaam & ".msg"
    Mail.Delete
  End If
End Sub

Function GetFolder() As String
    Dim fldr As FileDialog
    Dim sItem As String
    Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
    With fldr
        .Title = "Select a Folder"
        .AllowMultiSelect = False
        .InitialFileName = Application.DefaultFilePath
        If .Show = -1 Then sItem = .SelectedItems(1)
    End With
    GetFolder = sItem
    Set fldr = Nothing
End Function

Sub M_snb()
   with application.filedialog(4)
     if .show then 
        c00=.selecteditems(1)
        With CreateObject("Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(6)
          for each it in .Items
             it.saveas c00 & "\" & it.subject & ".msg"
           next
       end with 
   end with
End Sub