Office: Per Userform Order erstellen

Moin ihr Profis,
ich muss jedes Jahr sehr viele Ordner erstellen, was sehr Zeit intensiv ist.
Kann man eine Userform erstellen wo ich den Ordner auswählen kann wo dann erst die Monate erstellt werden und dann die Tage in den Monaten?
Vorher muss ich noch den Pfad eingeben können.
z.B. 1. Ordner Export 1 da sollen dann die Monate rein.
dann sollen in die Monate noch die Tage als Unterordner rein.
Ich habe mal eine Beispiel Datei hochgeladen mit den Daten.

Kann mir da einer helfen?

Vielen dank für die Mühe.

 

Hallo,

in der beiliegenden Datei habe ich dir in einem allgem. VBA-Codemodul das folgende Makro "VerzeichnisseErstellen"

Code:

Option Explicit

Public Sub VerzeichnisseErstellen()
  Dim rngOrdnerAuswahl As Range, OrdnerAuswahl As String
  Dim Pfad As String, Stammverzeichnis As String, MoVerzeichnis As String
  Dim Jahr As String, Mo As Integer, dt As Date
 
  On Error GoTo Err_VerzErstellen
 
  With Worksheets("Tabelle1")
     Set rngOrdnerAuswahl = .Range("N3:N9")  'Bereich "Auswahl Ordner"
     Pfad = .Range("N12").Value              'Bereich "Pfad"
  End With
 
  'Testen, ob AktiveZelle im Bereich "Auswahl Ordner"
  If Intersect(rngOrdnerAuswahl, ActiveCell) Is Nothing Then
     MsgBox "Die aktive Zelle (" & ActiveCell.Address & ") befindet sich nicht in der Ordnerauswahl."
  Else
     'Gib Jahr ein und teste es
     Jahr = InputBox(Prompt:="Geben Sie das zu erzeugende Jahr ein:", Title:="Jahreseingabe", Default:=Year(Date))
     If Len(Jahr) = 0 Then Exit Sub           '--> Abbruch-Button gedrückt
     If Not IsNumeric(Jahr) Then Exit Sub     '--> Jahr war keine Zahl
     If Val(Jahr) < 2020 Then Exit Sub        '--> Jahr war kleiner 2020
    
     dt = DateSerial(Jahr, 1, 1)  'Neujahrsdatum
 
     'Falls Pfad nicht existiert -> erzeuge ihn
     If Len(Dir(Pfad, vbDirectory)) = 0 Then MkDir Pfad
    
     OrdnerAuswahl = ActiveCell.Value
     Stammverzeichnis = Pfad & "\" & OrdnerAuswahl
    
     'Falls Stammverzeichnis nicht existiert -> erzeuge es
     If Len(Dir(Stammverzeichnis, vbDirectory)) = 0 Then MkDir Stammverzeichnis

     For Mo = 1 To 12
       dt = DateSerial(Jahr, Mo, 1)
       MoVerzeichnis = Stammverzeichnis & "\" & Format(dt, "MM YYYY")
       MkDir MoVerzeichnis
       Do
         MkDir MoVerzeichnis & "\Tag " & Format(dt, "DD")
         dt = dt + 1
       Loop While Month(dt) = Mo
     Next Mo
    
  End If
  Exit Sub
 
Err_VerzErstellen:

  MsgBox "Der Fehler " & Err.Number & vbNewLine & _
         "(" & Err.Description & ")" & vbNewLine & _
         "ist aufgetreten. --> Abbruch."

End Sub

eingefügt und den blauen Button "Erstelle Export-Verzeichnisse" damit verknüpft.

Bedienung:
1) Die aktive Zelle muss in den dunkelgrünen Zellbereich "Auswahl Ordner" positioniert werden.
2) Blauen Button anklicken
3) a) Dadurch wird der Pfad und die Auswahl Ordner als Startverzeichnis verwendet.
3) b) Es erscheint eine Inputbox, in die noch das Kalenderjahr einzugeben ist.
4) Mit diesen Angaben wird die Verzeichnisstruktur, wie sie in den Spalten A-L enthalten ist, erzeugt. Dabei werden allerdings die Angaben dieser Spalten (A-L) nicht benötigt, denn das Makro weiß selbst, wie so ein Kalenderjahr ausschaut und erzeugt die Verzeichnisse. Die Inhalte der Spalten A-L können also, was das Makro anbelangt, auch entfernt werden.

 

Moin,
das ist voll der Hammer.

Vielen dank.

 

Moin ich nochmal,
Was müsste geändert werden damit nur die Monate erstellt werden?

vielen Dank für die Mühe.

 

Dann hätte ich gerne gewusst, wie den Button erstellt hast?
Vielen dank

 

Hallo,

1) Menüband > Tabulator "Einfügen" > Gruppe "Illustrationen" > Listbox "Formen" > Abschnitt "Rechtecke" > Klick auf "Rechteck: Abgerundete Ecken"

2) Der Mauszeiger wird zu einem "+" - damit an die Stelle fahren, wo die linke obere Ecke des Rechtecks erscheinen soll.

3) Linke Maustaste niederdrücken und diese gedrückt halten und in diesem Status das Rechteck bis zur gewünschten Größe aufziehen (Mauszeiger ist dabei jeweils in der rechten unteren Ecke des Rechtecks platziert).

4) Sobald man mit dem Mauszeiger ins Innere des Rechtecks zeigt, erscheint ein spezielles Mauszeigerkreuz - damit ins Innere mit der rechten Maustaste klicken, den Befehl "Text bearbeiten" auswählen und den gewünschten Beschriftungstext eingeben.

5) Nochmals mit der rechten Maustaste ins Innere des Rechtecks klicken, den Befehl "Makro zuweisen..." auswählen, den Listeneintrag "VerzeichnisseErstellen" auswählen, OK-Button klicken

Fertig ist der Button samt Funktionalität.

 

Vielen dank,
kannst du mir das auch noch beantworten?

Danke

 

Hallo,

einfach die folgenden 4 Codezeilen weglassen:

Code:

      Do
        MkDir MoVerzeichnis & "\Tag " & Format(dt, "DD")
        dt = dt + 1
      Loop While Month(dt) = Mo

 

Moin,

vielen Dank.