Sub Sichern_BAO_Weiberfastnacht()
Dim expAktiv As Outlook.Explorer
Dim objItem As Object
Dim sName As String
Const strDatPfad As String = "N:\2017\02_Karneval\Posteingang LZ\"
Set expAktiv = Application.ActiveExplorer
For Each objItem In expAktiv.Selection
sName = objItem.Subject
ReplaceCharsForFileName sName, "_"
If TypeOf objItem Is Outlook.MailItem Then
objItem.SaveAs _
strDatPfad & sName & ".msg", olMSG
End If
Next objItem
Set expAktiv = Nothing
End Sub
Sub ReplaceCharsForFileName(sName As String, sChr As String)
sName = Replace(sName, "/", sChr)
sName = Replace(sName, "", sChr)
sName = Replace(sName, ":", sChr)
sName = Replace(sName, "?", sChr)
sName = Replace(sName, Chr(34), sChr)
sName = Replace(sName, "<", sChr)
sName = Replace(sName, ">", sChr)
sName = Replace(sName, "|", sChr)
End Sub