Const Ordnerstamm As String = "C:\"
Private Sub CommandButton1_Click()
Dim Ordnername As String
On Error GoTo Fehler
Ordnername = InputBox("Bitte Ordnernamen eingeben.", "Neuen Ordner erstellen.")
If Ordnername = "" Then Exit Sub
If Ordner_vorhanden(Ordnerstamm & Ordnername) = True Then
MsgBox "Es is schon ein Ordner mit diesem Namen (" & Ordnername & ") vorhanden.", vbExclamation, "Ordner schon vorhanden."
Exit Sub
Else
MkDir Ordnerstamm & Ordnername
MsgBox "Ordner wurde erfolgreich erstellt.", vbInformation, "Ordner erstellt."
End If
Exit Sub
Fehler:
MsgBox "Es ist ein Fehler beim erstellen des Ordners aufgetretten.", vbCritical, "Fehler"
End Sub
Public Function Ordner_vorhanden(Pfad As String) As Boolean
If Pfad = "" Then Ordner_vorhanden = False: Exit Function
If Right(Pfad, 1) <> "\" Then Pfad = Pfad & "\"
If Dir(Pfad, vbDirectory) <> "" Then
Ordner_vorhanden = True
Else
Ordner_vorhanden = False
End If
End Function