Ordner erstellen und Abfrage

Sub Main()
Dim objNewFolder As Object
Dim objFolder As Object
Dim objOutApp As Object
Dim objName As Object
Dim Ordner As String
On Error GoTo Fin
Set objOutApp = CreateObject("Outlook.Application")
Set objName = objOutApp.GetNamespace("MAPI")
Set objFolder = objName.GetDefaultFolder(6)
Ordner = InputBox("Bitte Ordnername eingeben!")
Set objNewFolder = objFolder.Folders.Add(Ordner)
Fin:
If Err.Number  0 Then MsgBox "Fehler: " & "Der Ordner ist bereits vorhanden"
Set objNewFolder = Nothing
Set objFolder = Nothing
Set objName = Nothing
Set objOutApp = Nothing
End Sub