Sub
InAktuellenOrdnerNeueOrdner()
Dim
OrdnerNeu$, Pfad_VorlageDatei$, aktuellerPfad$, FileExt$
Pfad_VorlageDatei =
"C:\Users\Uwe\Documents\RS-G Vorlage.xlsm"
FileExt = Mid(Pfad_VorlageDatei, InStrRev(Pfad_VorlageDatei,
"."
, , vbTextCompare), 5)
aktuellerPfad = ThisWorkbook.Path & "\"
OrdnerNeu = InputBox(
"Bitte Namen für neuen Ordner eintragen"
,
"Neuer Unterodner"
,
"RSG 08-24"
)
If
Dir(aktuellerPfad & OrdnerNeu, vbDirectory) =
""
Then
MkDir aktuellerPfad & OrdnerNeu
End
If
FileCopy Pfad_VorlageDatei, aktuellerPfad & OrdnerNeu &
"\" & "
Schüler" & OrdnerNeu & FileExt
End
Sub