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