Ordnerstruktur erstellen mit VBA

[bigcuno]

Hallo 

ich habe eine dynamische Liste erstellt in der alle Arbeitstage des Jahres enthalten sind. (abzüglich Feiertage). 
A1 = das Jahr

Ich möchte nun eine Ordnerstruktur per Knopfdruck anlegen, die mir dynamisch das Jahr "2024" als 1. Ebene anlegt. Auf der 2. Ebene dann die Monate "Jänner" - "Dezember" und auf der 3. Ebene die jeweiligen Arbeitstage. 
im Format "20240102"

Habt ihr Tipps - bin ganz neu beim Thema VBA. 

Habe wie folgt angefangen: 

Sub OrdnerErstellen()
    Dim Hauptordner As String
    Dim ws As Worksheet
    Dim Zellwert As Range

    ' Setze den Hauptordnerpfad hier ein
    Hauptordner = "C:\Users\npamit\Desktop"

    ' Setze die Arbeitsblattreferenz hier ein
    Set ws = ThisWorkbook.Sheets("Tabelle1")

    ' Gehe durch jede Zelle in der Spalte E (Annahme: Die Liste ist in Spalte E, startend ab Zeile 3)
    For Each Zellwert In ws.Range("E3:E" & ws.Cells(ws.Rows.Count, "E").End(xlUp).Row)
        ' Überprüfe, ob der Zellwert nicht leer ist
        If Zellwert <> "" Then
            ' Erstelle den Ordner
            MkDir Hauptordner & Zellwert.Value
        End If
    Next Zellwert

    MsgBox "Ordner wurden erstellt!", vbInformation
End Sub

[Ralf A]

Hi,

Du willst allen Ernstes für jeden Arbeitstag einen eigenen Ordner erstellen? Da freuen sich die Anwender sicher auf ein fröhliches durchklicken im Explorer wenn sie was suchen... :D
Das ergibt ja nur Sinn, wenn Du pro Tag mehrere Dateien dort ablegen willst. Ich vermute aber mal, dass dort immer nur eine "Tagesdatei" gleichen Typs landet. Somit brauchst Du nur eine Schleife von 1 bis 12 für die Monate und speicherst die Dateien mit dem Tagesdatum und/oder Erstellernamen im Dateinamen. Genau genommen kannst Du Dir dann sogar die Monatsordner sparen.... 
Aber selbstverständlich darf man sich auch totorganisieren... :D

[volti]

Hallo,

mal abgesehen von Ralf's berechtigtem Einwand hier eine Idee, wie Du Dein Vorhaben auch ganz leicht bewerkstelligen könntest.

Der alte, sicher auch immer noch oft genutzte, DOS-Befehl MKDIR erstellt einen neuen Ordner, basierend auf dem gerade aktiven Ordner, also als Unter- oder Unterunterordner.
Es gibt einen Fehler, wenn es ihn schon gibt. Diese Fehler muss man abfangen. Ganze Ordnerstrukturaufbauten müssen aufbauend stattfinden.

Deshalb empfehle ich Dir eine API-Version.

Diese erstellt eine ganze Ordnerstruktur, d.h. Du kannst gleich einen kompletten Pfad erstellen. Es werden diverse Fehlermeldungen herausgegeben, also etwa "Ordner schon vorhanden" usw.
Die Fehler muss man aber nicht abfragen, denn wenn es den Ordner schon gibt, passiert einfach nichts.

Hier ein Vorschlag (ungetestet). Probiere es einfach mal aus...

Code:

Private Declare PtrSafe Function SHCreateDirectoryExW Lib "Shell32.dll" ( _
        ByVal hwnd As LongPtr, ByVal pszPath As LongPtr, ByVal psa As LongPtr) As Long

Sub OrdnerErstellen()
  Dim sHauptordner As String
  Dim oRng As Range
  
  sHauptordner = "C:\Users\npamit\Desktop"

  With ThisWorkbook.Sheets("Tabelle1")
      For Each oRng In .Range("E3:E" & .Cells(.Rows.Count, "E").End(xlUp).Row)
         If oRng.Value <> "" Then
            SHCreateDirectoryExW 0, StrPtr(sHauptordner & "\" & oRng.Value & "\"), 0
'           SHCreateDirectoryExW 0, StrPtr(oRng.Value & "\"), 0     ' oder Angabe kompletter Ordner
         End If
      Next oRng
  End With
 
  MsgBox "Ordner wurden erstellt!", vbInformation, "Ordner erstellen"

End Sub

_________
viele Grüße
Karl-Heinz

[RPP63]

Moin!
Ich habe es so verstanden:

Code:

Option Explicit
Declare Function MakePath& Lib "imagehlp.dll" Alias _
       "MakeSureDirectoryPathExists" (ByVal sPath$)
Sub Ordnerstruktur()
Dim Zelle As Range
For Each Zelle In Range(Range("E2"), Range("E2").End(xlDown))
  MakePath "I:\Temp\" & Format(Zelle, "yyyy\\mm\\dd") & "\"
Next
End Sub

Da ich aus der Threaderöffnung nicht ganz schlau geworden bin:
Statt
Format(Zelle, "yyyy\\mm\\dd")
wäre ja auch folgendes denkbar:
Format(Zelle, "yyyy\\mm\\yyyymmdd")

Gruß Ralf

[volti]

Hallo Ralf,

ergänzend:

MakeSureDirectoryPathExists  tut natürlich hier was erforderlich ist. Man liest aber hier und da in Beiträgen und Foren, dass die Funktion veraltet sei und durch 
SHCreateDirectoryExW ersetzt werden sollte. Die Funktion SHCreateDirectoryExW  ist bzgl. des Handlings wesentlich flexibler.


Gruß KH

[snb]

Code:

Sub M_snb()
  With CreateObject("shell.application").Namespace("G:\")
    For j = 1 To DatePart("y", DateSerial(2025, 1, 0))
      .NewFolder Format(DateSerial(2024, 1, j), "yyyy\\mm\\dd")
    Next
  End With
End Sub

[EarlFred]

MakeSureDirectoryPathExists  ... SHCreateDirectoryExW 

Beide Funktionen können allerdings nicht (letztere: nicht zuverlässig) mit langen Pfaden über dem üblichen Limit Max_Path (260 Zeichen inkl, NULL) umgehen. 

Aus diesem Grund bin ich auf die Funktionen aus der Kernel32.dll umgestiegen. Da gibt es aber unglücklicherweise keine Funktion, die komfortabel komplette Pfade inklusive nicht existierender Zwischenebenen erstellt, da ist also "Handarbeit" angesagt.

Auf alle Fälle empfiehlt es sich aber, die Rückgabewerte auszuwerten, um den Erfolg der Funktion zuverlässig zu ermitteln.

[RPP63]

@snb:
Die Liste von bigcuno umfasst nicht 366 Daten wie bei Dir, sondern 253 (wenn er in NRW, Deutschland wohnt).

dynamische Liste erstellt in der alle Arbeitstage des Jahres enthalten sind. (abzüglich Feiertage)

Gruß Ralf

[snb]

Habe nie etwas von einem Feier gemerkt hier jenseits der Grenze der NRW
Die Leute haben 113 Feiertage pro Jahr ??
Die nehmen das Leben nicht ernst.

Scheint mir kein Hexentour die Feiertage in VBA auszuschließen.

[Ralf A]

Die Leute haben 113 Feiertage pro Jahr ??

...da würden sich die NRW'ner sicher drüber freuen, aber das eine oder andere Wochenende ist in den 113 freien Tagen pro Jahr bestimmt mit enthalten...