Neuen Ordner anlegen Inputbox

Sub NeuenOrdnerAnlegen()
Dim strfolder As String
Dim Ordnername As String
Dim Mldg, Titel, Voreinstellung, Wert1
Dim Verzeichnis As String
Dim dlg As Object
On Error Resume Next
Ordnername = Sheets("Daten").Range("C3").Value
Mldg = "Bitte die Ordnername benennen"
Titel = "Neuen Ordner anlegen...."
Voreinstellung = Ordnername
Ordnername = Application.InputBox(Mldg, Titel, Voreinstellung)
If Ordnername = "" Then Exit Sub
If Ordnername = False Then
Exit Sub
Else
Ordnername = Replace(Ordnername, "/", "_")
Ordnername = Replace(Ordnername, "*", "_")
Ordnername = Replace(Ordnername, "?", "_")
Verzeichnis = Left(ThisWorkbook.Path, InStrRev(ThisWorkbook.Path, "\") - 1) _
& Application.PathSeparator & "Projekte"
End If
'PrüfeObVerzeichnisVorhanden
strfolder = Verzeichnis & Application.PathSeparator & Ordnername
If Dir(strfolder, vbDirectory)  "" Then
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = Verzeichnis & Application.PathSeparator
.Title = "Der Ordnername ist bereits vorhanden der Vorgang wird abgebrochen ... "
.Show
End With
Exit Sub
Else
'lege Unterordner an
MkDir strfolder
End If
End Sub

Wenn der Ordnername "" ist soll abgebrochen werden.
Wenn die Schaltfläche Abbrechen gewählt wird soll abgebrochen werden.
If Ordnername = False Then geht aber immer auf Exit Sub, egal ob der Ordnername belegt oder "" ist.
Was ist zu tun?
Gruß Sonnenpeter