Makro Anpassung zusätzlicher Ordner
15.03.2024 16:54:02
resli
Ich habe ein Makro welches mir diverse Ordner erstellt, nun möchte ich es anpassen das es folgende Optionen bietet: (Aktuell mache ich es indem ich die Zelle D3 ändere und das Makro nochmals laufen lasse.
Jedoch währe es schön wenn ich es automatisch machen könne und auch variabel die Ordner nur erstellt werden wenn in den Zellen Text steht...
Erstellung Projektordners ein Unterordner erstellen mit -Ordner Bau und -Ordner Survey und -Ordner Verrechnung ....
in sämtlichen Unterordner sollten dieselben Ordner enthalten sein (wie es das aktuelle Makro generiert.
Bsp:
Projektordner
- Ordner Bau
- diverse Unterordner
- Ordner Survey
- diverse Unterordner
- Ordner Verrechnung
- diverse Unterordner
Option Explicit
Private Declare Function MakeSureDirectoryPathExists Lib "imagehlp.dll" (ByVal lpPath As String) As Long
Sub Ordner_erstellen()
Dim Zeilen As Long, Pfad As String, FullPfad As String, i As Long
Zeilen = Range("b10000").End(xlUp).Row
Pfad = Range("h5")
For i = 7 To Zeilen
FullPfad = Pfad & Cells(i, 2) & "\" & Range("c5") & "\" & Range("c6") & "\"
Call MakeSureDirectoryPathExists(FullPfad)
Next i
For i = 7 To Zeilen
FullPfad = Pfad & Cells(i, 2) & "\" & Range("d5") & "\" & Range("d6") & "\"
Call MakeSureDirectoryPathExists(FullPfad)
Next i
For i = 7 To Zeilen
FullPfad = Pfad & Cells(i, 2) & "\" & Range("e5") & "\" & Range("e6") & "\"
Call MakeSureDirectoryPathExists(FullPfad)
Next i
For i = 7 To Zeilen
FullPfad = Pfad & Cells(i, 2) & "\" & Range("f5") & "\" & Range("f6") & "\"
Call MakeSureDirectoryPathExists(FullPfad)
Next i
End Sub
Hier noch die Excel Datei:
https://www.herber.de/bbs/user/168030.xlsm