Clever-Excel-Forum

Seiten: 1 2

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
.
.
.

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?

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

Hallo,

OK, dann kannst du das ja von Hand machen.

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

Hallo,

Zitat: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.

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)

So schaut es bei mir aus Smile

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)

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

Seiten: 1 2

jennywi

Klaus-Dieter

jennywi

Klaus-Dieter

jennywi

Klaus-Dieter

Fennek

jennywi

Fennek

jennywi