Office: (Office 2010) komplexe Ordnerstrukturen via Excel VBA anlegen

Hallo zusammen,
(sorry falls ich hier einen doppelten Post aufmache, aber schätze ich war in dem anderen Forum an der falschen Adresse, da VBa und kein Excel VBA)
Jetzt zum Thema
Ich würde gerne meinen Kindern beim Umgang mit Ihren Studien Unterlagen helfen.
Für mich hatte ich schon immer ein kleines Excelsheet mit Ordnernamen und zig Unterordner im Einsatz. Funktioniert auch soweit.
Jetzt habe ich meinen Mund zu voll genommen und ihnen gesagt, ich werde euch was bauen.
Ich wende seit Jahren Excel VBA an, aber eher sehr Hemdsärmelig und mit viel Unterstützung aus dem Netz.
Klassisch so: Die Ordnerbezeichnungen sind einfach mal so dahingestellt.
1. Laufwerk und Hauptverzeichnis wählen oder anlegen.
2. Ebene 2 (hier bis zu 6 Unterverzeichnisse möglich "A-E ; F-J ; K-O ; P-T ; U-Z ; Sonstige", dient zu Übersichtlichkeit der Themen)
3. Ebene 3 (hier bis zu 3 Unterverzeichnisse je UV-Ebene 2 möglich "01_Erhalten ; 02_in Arbeit ; 03_Abgegeben)
4. Ebene 4 (hier bis zu 2 Unterverzeichnisse je UV-Ebene 3 möglich "JJMMTT_Version_in Arbeit; JJMMTT_Version_Abgeschlossen)

Beschreibung:
Ich habe eine Userform, mit mehreren Frames.
dort werden Optionbuttens angewählt und damit Textfelder aktiviert, die dann als Grundlage für die Verzeichnisstruktur dienen.
hier kann das Laufwerk und das Hauptverzeichnis ausgewählt, falls noch nicht vorhanden auch angelegt werden --> funktioniert.
Private Sub CB_Ebene_1_Click()

Schalter = OB1 '##
LW = TB_DEF_LW.Value
HV = TB_EBENE_1.Value


If Schalter = True Then
sDir = LW & "" & HV 'Hauptverzeichnis (Ebene 1) auf Laufwerk anlegen, falls nicht vorhanden

If Dir(sDir, vbDirectory) "" Then
MsgBox "Verzeichnis existiert schon"
CB_Ebene_1.Visible = False
Else

'MkDir sDir
MsgBox sDir & " wurde angelegt"
End If
On Error Resume Next
Else
MsgBox "ein Fehler, bitte erst Ebene 1 Hauptverzeichnis angeben"
End If

End Sub
FRAME 2 (Unterverzeichnisse Ebene 2 anlegen) -->funktioniert, gefühlt super.
Private Sub CB_EBENE_2_Click()
Dim ctrl As Control
Dim i As Integer
Dim Schalter As String
Dim Fso, strV
Dim Anzahl As Integer
Dim ZAEHLER As Integer
Dim max As Integer
Dim HV As String
Dim UV2 As Variant
Dim EB As String
Dim xEBENE2 As String
i = 0
For Each ctrl In Me.Frame2.Controls
If TypeOf ctrl Is MSForms.CheckBox Then
LW = TB_DEF_LW.Value
HV = TB_EBENE_1.Value
OB_NAME = ctrl.Name
OB_EIGENSCHAFT = ctrl.Value

xEBENE2 = "TB_EBENE_" & Right(OB_NAME, Len(OB_NAME) - 2)

With Controls(xEBENE2)
UV2 = .Value
End With

sDir = LW & "" & HV & "" & UV2

i = i + Abs(ctrl.Value)

If OB_EIGENSCHAFT = True Then
Set Fso = CreateObject("Scripting.FileSystemObject")

If Fso.FolderExists(sDir) = True Then
MsgBox sDir & " existiert bereits"
On Error Resume Next
End If

On Error Resume Next
If Fso.FolderExists(sDir) = False Then
MkDir sDir
MsgBox sDir & " wurde angelegt"
End If
End If
End If
Next ctrl
End Sub
FRAME 3 (Unterverzeichnisse Ebene 3 anlegen) --> ab hier komme ich nicht weiter, bzw. ist mein Mund zu voll gewesen.
die Fehlermeldung Next ohne For bringt mich zum verzweifeln.
Private Sub CB_EBENE_3_Click()

Dim i As Integer
Dim Schalter As String
Dim Fso, strV
Dim Anzahl As Integer
Dim ZAEHLER As Integer
Dim max As Integer
Dim HV As String
Dim UV2 As Variant
Dim UV3 As Variant
Dim EB As String
Dim xEBENE2 As String

i = 0

For Each ctrl_1 In Me.Frame2.Controls
If TypeOf ctrl Is MSForms.CheckBox Then
LW = TB_DEF_LW.Value
HV = TB_EBENE_1.Value
OB_NAME2 = ctrl.Name
OB_EIGENSCHAFT = ctrl.Value

For Each ctrl_2 In Me.Frame3.Controls
If TypeOf ctrl Is MSForms.CheckBox Then
LW = TB_DEF_LW.Value
HV = TB_EBENE_1.Value
OB_NAME3 = ctrl.Name
OB_EIGENSCHAFT2 = ctrl.Value

Stop

xEBENE2 = "TB_EBENE_" & Right(OB_NAME2, Len(OB_NAME2) - 2)
xEBENE3 = "TB_EBENE_" & Right(OB_NAME3, Len(OB_NAME3) - 2)

With Controls(xEBENE2)
UV2 = .Value
End With

With Controls(xEBENE3)
UV3 = .Value
End With

sDir = LW & "" & HV & "" & UV2 & "" & UV3

i = i + Abs(ctrl.Value)

If OB_EIGENSCHAFT = True Then
Set Fso = CreateObject("Scripting.FileSystemObject")

If Fso.FolderExists(sDir) = True Then
MsgBox sDir & " existiert bereits"
On Error Resume Next
End If

On Error Resume Next
If Fso.FolderExists(sDir) = False Then
MkDir sDir
MsgBox sDir & " wurde angelegt"
End If
End If
End If

Next ctrl_2
Next ctrl_1
End Sub
Wie oben bereits erwähnt:
Excel VBA programiere ich Hemdsärmelig, also bin ich eher ein erfahrener Anfänger.
Ob die Ordnerstruktur so sinnvoll ist will ich nicht wissen, sie ist halt einfach so gewünscht.
Ich weiß leider nicht wie ich hier das Excel-Dokument einstellen kann,
deshalb die Code-Schnipsel oben.

Es wäre super Nett, wenn mir hier jemand helfen kann, danke
bhawener

:)

 

Keine Ahnung, was Du willst, ich rate mal, Du benötigst eine Funktion, um eine Ordnerstruktur anzulegen, siehe hier bzw. hier

MakeSureDirectoryPathExists-Funktion: Diese Funktion erstellt einen kompletten Verzeichnispfad inklusive noch nicht vorhandener Unterordner.

 

Hallo,

deinen Code habe ich nicht gelesen, aber nach der Einleitung sollte das passen:

Code:

mfg

 

Moin!
In welchem Thread machst du jetzt weiter? Hatte dir im anderen nochmal geantwortet. Wäre jetzt aber umständlich immer in zweien zu lesen.
VG

 

Hier interessiert nicht mehr, ein CP - A eben
http://www.vba-forum.de/forum/View.a...el_VBA_anlegen

 

Hallo,

die von dir zitierte Fehlermeldung besagt, dass die IF- oder For-Syntax nicht richtig ist.
Wenn man dann deinen Code einrückt, sieht man, dass ein "end if" fehlt. Ich habe gerade kein Excel und auch kein VBA zur Verfügung, kann daher nicht testen. Doch rein von der Syntax her tippe ich mal darauf, dass du das erzielen wolltest: Code:

In dem Code hast du noch ein Problem mit deinen Variablen: du sprichst u.a. "ctrl" an, die Variable ist aber nicht deklariert. Dann definierst du mehrfach LW, ...
Aber das kannst du bestimmt korrigieren.. ?


Das hier: Code:

ergibt übrigens wenig Sinn:
zuerst sagst du, dass wenn ein Fehler auftaucht, einfach die nächste Codezeile ausgeführt wird. Wenn also MkDir sDir einen Fehler verursacht, dann wird die nächste Zeile ausgeführt, die die Meldung raus gibt, dass der Ordner richtig angelegt wurde. => nicht sinnvoll!!
Verzichte auf On Error Resume Next.


MkDir kann nur einen Ordner in einem bereits existierenden Verzeichnis anlegen. Willst du du (evtl.) Ordner in Verzeichnissen anlegen, die evtl. nicht existieren, benutze einfach die API-Funktion MakeSureDirectoryPathExists wie Fennek es dir gezeigt hat. Das tolle ist, dass die Funktion nichts löscht. Du musst noch nicht mal abfragen, ob das Verzeichnis schon besteht. Und On Error Resume Next benötigst du erst recht nicht.

Kommst du klar?
Grüße, Ulrich