Private Sub Command1_Click()
 
Dim objFolder As MAPIFolder
Dim objFolderId As String
Dim G_objFolderId As String
Dim objMailSel As MailItem
Dim objSelection As Selection
 
Dim SpeicherZiel As String
 
SpeicherZiel = "c:\NurTest\"
 
 
'Hier taucht der Fehler auf
'-------------------------------------------------------
Select Case Application.ActiveWindow.Class
'-------------------------------------------------------
 
 
Case olExplorer
objFolderId = Application.ActiveExplorer.CurrentFolder.EntryID
Set objFolder = Application.ActiveExplorer.CurrentFolder
If Application.ActiveExplorer.CurrentFolder.Items.Count > 0 Then
If objFolder.DefaultMessageClass <> "" Then 'War  = "IPM.Note"
Set objSelection = Application.ActiveExplorer.Selection
Select Case objSelection.Count
Case 0
MsgBox "Es sind keine E-Mails ausgewählt !"
 
Case Else
For Each object In objSelection 'objMailSel In objSelection
    'SaveMailAsFile
    newname = object.Subject 'objMailSel.Subject
'    newname = test.Subject 'objMailSel.Subject
    newname = Replace(newname, "(", "")
    newname = Replace(newname, ")", "")
    newname = Replace(newname, "/", "")
    newname = Replace(newname, "\", "")
    newname = Replace(newname, ":", "")
    newname = Replace(newname, "+", "")
    newname = Replace(newname, "<", "")
    newname = Replace(newname, ">", "")
    newname = Replace(newname, "=", "")
    newname = Replace(newname, ",", "")
    object.SaveAs SpeicherZiel & newname & ".msg", olMSG 'objMailSel.SaveAs 
    ' "C:\ARDAS\" & newname & ".msg
Next
End Select
Set objSelection = Nothing
Else
MsgBox "Es sind keine E-Mails ausgewählt"
End If
End If 'Application.ActiveExplorer.CurrentFolder.Items.Co unt
 
Set objFolder = Nothing
 
Case olInspector
With Application.ActiveInspector
If .CurrentItem.Class = olMail Then
Set objMailSel = .CurrentItem
Set objMailSel = Nothing
 
Else
MsgBox "Es ist kein E-Mail aktiv"
End If
End With
 
Case Else
End Select
 
 
End Sub