Ordner erstellen aus Makro Skript

[jennywi]

Guten Morgen ihr Lieben,


ich habe mein Problem zwar schon in teilen in diesem Forum gefunden, leider war es noch nicht Problemlösend.
Wie der Betreff schon sagt muss ich Ordner mit einer gewissen Unterstruktur erstellen.
Ich habe eine Reihe an Equipments (4.000stk.) und in jeden dieser Ordner müssen 6 weiter.

Mein Quelltext lautet aktuelle:

Sub OrdnerErstellen()
Dim fso As Object
Dim i As Integer
Dim strPfad As String
Dim appWord As Object
Dim strText As String

Set fso = CreateObject("Scripting.Filesystemobject")

For i = 2 To Cells(Rows.Count, 3).End(xlUp).Row
  strPfad = ThisWorkbook.Path & "\" & Cells(i, 3) & ", " & Cells(i, 4) & " " & Cells(i, 5)
    If Not ordnerda(strPfad) Then
        MkDir strPfad
        MkDir strPfad & "\Abnahme"
        MkDir strPfad & "\Einweisung"
        MkDir strPfad & "\Gebrauchsanweisung - Pflegehinweise"
        MkDir strPfad & "\Gefährdungsbeurteilung"
        MkDir strPfad & "\Komformitätserklärung"
        MkDir strPfad & "\Validierung"
    End If
Next i
Set fso = Nothing

    strText = " Die Ordner mit den Dokumenten wurden angelegt !!!"
    MsgBox strText, 64, "Meldung"

End Sub

Ich habe in Spalte/ Zeile A1 den beginn der laufenden Nummern.


2000349007
2000349006
2000349005
2000349004
2000349003
2000349002
.
.
.

[Klaus-Dieter]

Hallo,

bestimmt bin ich der letzte, der von der Verwendung von Makros abrät. Aber ein Makro zum Erstellen von Verzeichnissen? Das ist sicher mit Kanonen auf Spatzen geschossen. Wie oft kommt es denn vor, dass neue Verzeichnisse erstellt werden müssen?

[jennywi]

Tatsächlich nur 1x in 100 Jahren  :32:

[Klaus-Dieter]

Hallo,

OK, dann kannst du das ja von Hand machen.

[jennywi]

Das stimmt, wenn es nicht um 4.000 Ordner mit Unterstruktur gehen würde  :16:

[Klaus-Dieter]

Hallo,

Das stimmt, wenn es nicht um 4.000 Ordner mit Unterstruktur gehen würde

dann müsste, wie ich meine, eure Arbeitsweise überdacht werden. Für so etwas gibt es Datenbanken.

[Fennek]

Hallo,

der gezeigte Code ist fast richtig, es wäre aber hilfreich die Inhalte der Spalten A-E zu kennen.

Ohne Test:

Code:

Sub OrdnerErstellen()

For i = 2 To Cells(Rows.Count, 3).End(xlUp).Row
  strPfad = ThisWorkbook.Path & "\" & Cells(i, 3) & ", " & Cells(i, 4) & " " & Cells(i, 5)
  
' ### Änderung ###
If dir(strPfad) = "" Then
'###
        MkDir strPfad
        MkDir strPfad & "\Abnahme"
        MkDir strPfad & "\Einweisung"
        MkDir strPfad & "\Gebrauchsanweisung - Pflegehinweise"
        MkDir  strPfad & "\Gefährdungsbeurteilung"
        MkDir strPfad & "\Komformitätserklärung"
        MkDir strPfad & "\Validierung"
    End If
Next i
beep
End Sub

mfg

(X-Post mit Herber, hoffentlich keine Überschneidung)

[jennywi]

So schaut es bei mir aus

[Fennek]

Wer kam den auf diese Idee?

Code:

strPfad = ThisWorkbook.Path & "\" & Cells(i, 3) & ", " & Cells(i, 4) & " " & Cells(i, 5)

Wieder ungeprüft:

Code:

For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row
  strPfad = ThisWorkbook.Path & "\" & Cells(i, 1)
    If dir(strPfad) = "" Then
        MkDir strPfad
        MkDir strPfad & "\Abnahme"
        MkDir strPfad & "\Einweisung"
        MkDir strPfad & "\Gebrauchsanweisung - Pflegehinweise"
        MkDir strPfad & "\Gefährdungsbeurteilung"
        MkDir strPfad & "\Komformitätserklärung"
        MkDir strPfad & "\Validierung"
    End If
Next i

mfg

(Teste bitt die ersten 2-3 Zeilen im Einzelschrittmodus F-8)

[jennywi]

Meeeega. Vielen vielen Dank  :05: :05: :05: :05: