Thema: Per VBA Ordner anlegen mit Namen aus Zellen

Guten Morgen,

in einer produktiven Tabelle habe ich ein Tabellenblatt "MG Werte". In diesem befinden sich Werte in Spalte B, welche jeweils eine Zelle der Spalte belegen. Von B1 - B200 kann alles belegt sein, oder aber auch nur B1. Die Länge der Spalte ist Variabel.

Nun hätte ich gerne eine Schleife, die die Spalte durchläuft, und aus jedem Wert einen Ordner anlegt. Der Pfad ist vorher definiert.

In dem erstellten Unterordner sollen weitere, festbenannte, Unterordner erstellt werden.

Bisher habe ich das sehr rudimentär gelöst. Da ich die ganze Funktionsweise gerade umbaue, hätte ich hier gerne eine schönere Lösung

Bisher geschieht das so (sensible Daten sind durch "Beispiel" geändert.

Private Sub Create_Folder()



Dim strDateiname As String



    strFolderPath01 = "C:\Users\" & Environ("Username") & "\Documents\Beispiel01\" & Format(Now, "yyyy") & "\Beispiel02\"

    strFolderPath02 = "C:\Users\" & Environ("Username") & "\Documents\Beispiel01\" & Format(Now, "yyyy") & "\Beispiel02\" & Format(Now, "mm") & " " & Format(Now, "mmmm") & " " & Format(Now, "yyyy") & "\"

    strFolderPath03 = "C:\Users\" & Environ("Username") & "\Documents\Beispiel01\" & Format(Now, "yyyy") & "\Beispiel02\" & Format(Now, "mm") & " " & Format(Now, "mmmm") & " " & Format(Now, "yyyy") & "\" & Format(Now, "dd.mm") & " " & "Lokal" & "\"

    strFolderPath04 = "C:\Users\" & Environ("Username") & "\Documents\Beispiel01\" & Format(Now, "yyyy") & "\Beispiel02\" & Format(Now, "mm") & " " & Format(Now, "mmmm") & " " & Format(Now, "yyyy") & "\" & Format(Now, "dd.mm") & " " & "Lokal" & "\" & Range("F173").Text & "\"

    strFolderPath05 = "C:\Users\" & Environ("Username") & "\Documents\Beispiel01\" & Format(Now, "yyyy") & "\Beispiel02\" & Format(Now, "mm") & " " & Format(Now, "mmmm") & " " & Format(Now, "yyyy") & "\" & Format(Now, "dd.mm") & " " & "Lokal" & "\" & Range("F173").Text & "\" & "Beispiel03"

    strFolderPath06 = "C:\Users\" & Environ("Username") & "\Documents\Beispiel01\" & Format(Now, "yyyy") & "\Beispiel02\" & Format(Now, "mm") & " " & Format(Now, "mmmm") & " " & Format(Now, "yyyy") & "\" & Format(Now, "dd.mm") & " " & "Lokal" & "\" & Range("F173").Text & "\" & "Beispiel04"

    

    If Dir(strFolderPath01, vbDirectory) = "" Then

    ' Ordner anlegen

    MkDir (strFolderPath01)

    Else

    ' mache irgendwas

    End If

    

    If Dir(strFolderPath02, vbDirectory) = "" Then

    ' Ordner anlegen

    MkDir (strFolderPath02)

    Else

    ' mache irgendwas

    End If

    

    If Dir(strFolderPath03, vbDirectory) = "" Then

    ' Ordner anlegen

    MkDir (strFolderPath03)

    Else

    ' mache irgendwas

    End If

    

    If Dir(strFolderPath04, vbDirectory) = "" Then

    ' Ordner anlegen

    MkDir (strFolderPath04)

    Else

    ' mache irgendwas

    End If

    

    If Dir(strFolderPath05, vbDirectory) = "" Then

    ' Ordner anlegen

    MkDir (strFolderPath05)

    Else

    ' mache irgendwas

    End If



    If Dir(strFolderPath06, vbDirectory) = "" Then

    ' Ordner anlegen

    MkDir (strFolderPath06)

    Else

    ' mache irgendwas

    End If

    

    'Ordner öffnen

    Call Shell("explorer.exe" & " " & strFolderPath03, vbNormalFocus)

    

End Sub

Hallo,

"MkDir" ist der VBA-Befehl neue Ordner anzulegen.

Alternativ und mit dem Vorteil, dass nichts passiert, falls der Ordner bereits existiert ist

Private Declare PtrSafe Function MakeSureDirectoryPathExists Lib "imagehlp.dll" ( _

    ByVal DirPath As String) As Long



sub New_Filder()

dim rtn as long



rtn = MakeSureDirectoryPathExists("c:\temp\Ordner_neu")

end sub

Natürlich kann der Pfad auch mit Variablen spezifiziert werden.

Falls der Pfad-Name Unicode-Zeichen enthält, gibt es eine andere Function.

mfg

Guten Morgen Fennek,

erstmal Danke für Deine Antwort.

Was das eigentliche "Problem" ist, ist das ich eine Schleife brauche, die Zählt wie viele Zeilen in Spalte B gefüllt sind, und entsprechend viele Ordner im Pfad anlegt. Jeder Ordner muss den Namen einer Zelle der Spalte B fortlaufend haben.

Das ist erstmal das erste was mich schon vor ein großes Rätsel stellt. Aktuell bin ich unterwegs. Ansonsten kann ich bei Bedarf eine Beispieldatei hochladen, wobei das nur x-Werte in Spalte B stehen würden, denke auch nicht sehr hilfreich

" ist das ich eine Schleife brauche, die Zählt wie viele Zeilen in Spalte B gefüllt sind" ?
Da brauchst du doch keine Schleife - Dafür reicht doch Anzahl2 bzw Anzahl oder für VBA die Worksheetfunction dazu.

...

Hallo Axel,

das wäre in Schleife so besser und bequemer:

Option Explicit

#If VBA7 Then

    Declare PtrSafe Function MakePath Lib "imagehlp.dll" Alias "MakeSureDirectoryPathExists" (ByVal lpPath As String) As Long

#Else

    Declare Function MakePath Lib "imagehlp.dll" Alias "MakeSureDirectoryPathExists" (ByVal lpPath As String) As Long

#End If



Sub APIMakeSureDirectoryPathExists(strVerzeichnis As String)

    If MakePath(strVerzeichnis) = 0 Then

        MsgBox "Verzeichnis konnte nicht erstellt werden!", vbCritical

        End

    End If

End Sub



Sub LegVerzeichnisAn()

    Dim i&, arrPfade(), Pfad$

    arrPfade = Array("C:\Users\" & Environ("Username") & "\Documents\Beispiel01\" & Format(Now, "yyyy") & "\Beispiel02", _

        "C:\Users\" & Environ("Username") & "\Documents\Beispiel01\" & Format(Now, "yyyy") & "\Beispiel02\" & Format(Now, "mm") & " " & Format(Now, "mmmm") & " " & Format(Now, "yyyy") & "\", _

        "C:\Users\" & Environ("Username") & "\Documents\Beispiel01\" & Format(Now, "yyyy") & "\Beispiel02\" & Format(Now, "mm") & " " & Format(Now, "mmmm") & " " & Format(Now, "yyyy") & "\" & Format(Now, "dd.mm") & " " & "Lokal" & "\", _

        "C:\Users\" & Environ("Username") & "\Documents\Beispiel01\" & Format(Now, "yyyy") & "\Beispiel02\" & Format(Now, "mm") & " " & Format(Now, "mmmm") & " " & Format(Now, "yyyy") & "\" & Format(Now, "dd.mm") & " " & "Lokal" & "\" & Range("F173").Text & "\", _

        "C:\Users\" & Environ("Username") & "\Documents\Beispiel01\" & Format(Now, "yyyy") & "\Beispiel02\" & Format(Now, "mm") & " " & Format(Now, "mmmm") & " " & Format(Now, "yyyy") & "\" & Format(Now, "dd.mm") & " " & "Lokal" & "\" & Range("F173").Text & "\" & "Beispiel03", _

        "C:\Users\" & Environ("Username") & "\Documents\Beispiel01\" & Format(Now, "yyyy") & "\Beispiel02\" & Format(Now, "mm") & " " & Format(Now, "mmmm") & " " & Format(Now, "yyyy") & "\" & Format(Now, "dd.mm") & " " & "Lokal" & "\" & Range("F173").Text & "\" & "Beispiel04")

    For i = 0 To UBound(arrPfade)

        Pfad = arrPfade(i)

        Call APIMakeSureDirectoryPathExists(Pfad)

    Next i

End Sub

ich habe grad gesehen, dass es ja nur um einen Pfad geht.
Dass wäre das Array so:

arrPfade = Array("C:\Users\" & Environ("Username") & "\Documents\Beispiel01\" & Format(Now, "yyyy") & "\Beispiel02\" & Format(Now, "mm") & " " & Format(Now, "mmmm") & " " & Format(Now, "yyyy") & "\" & Format(Now, "dd.mm") & " " & "Lokal" & "\" & Range("F173").Text & "\" & "Beispiel03", _

                 "C:\Users\" & Environ("Username") & "\Documents\Beispiel01\" & Format(Now, "yyyy") & "\Beispiel02\" & Format(Now, "mm") & " " & Format(Now, "mmmm") & " " & Format(Now, "yyyy") & "\" & Format(Now, "dd.mm") & " " & "Lokal" & "\" & Range("F173").Text & "\" & "Beispiel04")

Gruß Uwe

Hallo AxelF!

Was ich gemacht habe:

Variable dimensioniert

Pfadteile in Variable gepackt um es übersichtlicher zu machen

Nur Pfade mit variablem Anteil sind in der Schleife.

Schleife gebaut für jeden Pfad, der zu prüfen ist bzw Ordner anzulegen

Schleife gebaut um jede gefüllte Zelle in B den Pfad aus "F" zu vervollständigen (vorher "F173")

Private Sub Create_Folder()



    Dim strDateiname As String

    Dim strFolderPath01 As String

    Dim strFolderPath02 As String

    Dim strFolderPath03 As String

    Dim strFolderPath04 As String

    Dim strFolderPath05 As String

    Dim strFolderPath06 As String

    Dim pfad_array As Variant



    Teil_A As String

    Teil_B As String

    Teil_D As String

    Teil_D As String

    

    Teil_A = "C:\Users\" & Environ("Username") & "\Documents\Beispiel01\" & Format(Now, "yyyy") & "\Beispiel02\"

    Teil_B = Format(Now, "mm") & " " & Format(Now, "mmmm") & " " & Format(Now, "yyyy") & "\"

    Teil_C = Format(Now, "dd.mm") & " " & "Lokal" & "\"

    

    strFolderPath01 = Teil_A

    strFolderPath02 = Teil_A & Teil_B

    strFolderPath03 = Teil_A & Teil_B & Teil_C

    

    For Each cl In Range("B1:B200").SpecialCells(xlConstants)

        

        Teil_D = Range("F" & cl.Row).Text



        strFolderPath04 = strFolderPath03 & Teil_D & "\"

        strFolderPath05 = strFolderPath03 & Teil_D & "\" & "Beispiel03"

        strFolderPath06 = strFolderPath03 & Teil_D & "\" & "Beispiel04"

        

        pfad_array = Array(strFolderPath01, strFolderPath02, strFolderPath03, strFolderPath04, strFolderPath05, strFolderPath06)

        

        For I = 0 To UBound(pfad_array)

            If Dir(pfad_array(I), vbDirectory) = "" Then

                ' Ordner anlegen

                MkDir (pfad_array(I))

            Else

                ' mache irgendwas

            End If

        Next I

    Next cl

    

    'Ordner öffnen

    Call Shell("explorer.exe" & " " & strFolderPath03, vbNormalFocus)

    

End Sub

Schau mal, ob das passt

Gruß, MCO

Ist es so nicht etwas übersichtlicher?

    Dim strDateiname As String

    Dim pa, j, m1, m2, txt

    pa = "C:\Users\" & Environ("Username") & "\Documents\Beispiel01\"

    j = Format(Now, "yyyy")

    m1 = Format(Now, "mm")

    m2 = Format(Now, "mmmm")

    dm = Format(Now, "dd.mm")

    txt = Range("F173").Text

    strFolderPath01 = pa & j & "\Beispiel02\"

    strFolderPath02 = strFolderPath01 & m1 & " " & m2 & " " & j & "\"

    strFolderPath03 = strFolderPath02 & dm & " " & "Lokal" & "\"

    strFolderPath04 = strFolderPath03 & txt & "\"

    strFolderPath05 = strFolderPath04 & "Beispiel03"

    strFolderPath06 = strFolderPath04 & "Beispiel04"

    

    If Dir(strFolderPath01, vbDirectory) = "" Then

    ....

    ....

Hi
in deinem Beispiel kommt Spalte B nicht vor!
das macht es schwierig, aus deinem Code ein passendes Beispiel zu erstellen.

eine schleife über alle Textwerte in Spalte B könnte so aussehen.
das SpecialCells wählt dann aus der Spalte B die Zellen aus, die einen konstanten (xlcelltypeconstants) Text (die 2) enthalten.
in der Spalte sollte aber mindestens eine Zelle mit Text vorhanden sein, wenn das .SpecialCells keine passende Zelle finden kann, gibt es einen Fehler

dim rngB as range

for each rngB in Sheet("MG Werte").Range("B:B").SpecialCells(xlcelltypeconstants, 2)

   'rngB.Value ist dann die Variable mit dem jeweiligen Text

next

das nächste Problem:
mkDir kann immer nur eine Ordnerstufe anlegen, dh in einem vorhandenen Ordner EINEN neuen Ordner anlegen.
wenn die API-Funktion nicht erwünscht ist, kann man auch mit einer kleinen Schleife regeln, dass ein Ordner immer angelegt wird, auch in mehreren Stufen gleichzeitig.
ist der Ordner schon vorhanden, läuft die Schleife durch ohne das etwas passiert.

Sub OrdnerErstellen()

Dim p As Long

Dim OrdnerPfad As String

OrdnerPfad = "C:\Users\xxxxx\Downloads\Test1\Test2\" 'anzulegende Ordnerstrkutur mit "\" am Ende

p = 0

Do

    p = InStr(p + 1, OrdnerPfad, "\")

    If p = 0 Then Exit Do

    If Dir(Left(OrdnerPfad, p - 1), vbDirectory) = "" Then MkDir Left(OrdnerPfad, p - 1)

Loop

End Sub

Gruß Daniel

Hallo an alle die geholfen haben,

vielen Dank!!!

Am Ende bin ich mit dem Vorschlag von MCO am besten klar gekommen und konnte es auf meine Gegebenheiten genau anpassen.

Es ist sehr spannend zu sehen, wie unterschiedlich man an ein Thema gehen kann, klasse, ich habe viel mitgenommen.

Danke nochmal an alle für die Hilfe und Eure Zeit.