Pasted

Sub SlaMailOp()
 
  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 = "c:\Mails"
  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, ";", "")
    Mail.Categories = "VKG"
    Mail.SaveAs Map & BestandsNaam & ".msg", olMSG
  End If
 
End Sub