nächsten freien Ordnernamen suchen

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Private Sub UserForm_Activate() 'nächste neuen Ordner ermitteln Dim arrOrdnerNeu() As String, arrOrdner(), iCount As Integer Dim FSO As Object 'FileSystemObject Dim fsoFolder As Object 'Folder Dim fsoSubfolder1 As Object 'Folder Dim fsoSubfolder2 As Object 'Folder Dim Nr_Max As Integer, Nr_File As Integer Set FSO = CreateObject("Scripting.FileSystemObject") Set fsoFolder = FSO.GetFolder("C:\Users\Public\Test\Mathias") 'Hauptordner - anpassen!!!!! iCount = 0 '1. Ebene der Unterordner im Hauptordner abarbeiten For Each fsoSubfolder1 In fsoFolder.SubFolders Nr_Max = 0 If fsoSubfolder1.SubFolders.Count = 0 Then 'Ordner hat noch keinen unterordner Else 'Ordner mit der größten Zählnummer in Unteordner der Ebene 2 ermitteln For Each fsoSubfolder2 In fsoSubfolder1.SubFolders Nr_File = Val(Right(fsoSubfolder2.Name, 3))' letzte 3 Zeichen des Ordnernamens _ als Zahl auswerten If Nr_File > Nr_Max Then Nr_Max = Nr_File Next End If iCount = iCount + 1 ReDim Preserve arrOrdnerNeu(1 To iCount) ReDim Preserve arrOrdner(1 To iCount) Nr_Max = Nr_Max + 1 arrOrdner(iCount) = fsoSubfolder1.Path arrOrdnerNeu(iCount) = fsoSubfolder1.Name & Format(Nr_Max, "000") Next 'Auswahl für neue Ordner in Listbox übertragen With Me.ListBox1 'Namen der Listbox ggf. anpassen!!!!! .Clear .ColumnCount = 2 .ColumnWidths = "50Pt;0Pt" 'der zugehörige Unterordner wird in der Listbox in der _ 2. Spalte erfasst, aber nicht angezeigt For iCount = LBound(arrOrdnerNeu) To UBound(arrOrdnerNeu) .AddItem arrOrdnerNeu(iCount) .List(.ListCount - 1, 1) = arrOrdner(iCount) Next End With End Sub

Hallo Franz,
vielen Dank für deinen Vorschlag, jedoch werden in der Listbox alle in dem Unterordner befindlichen Ordner angezeigt und auch zeigt es die Namen falsch an z.b. A001001 A002001 A003001 usw. (original Ordnername A001 A002 A003) Im Beistpiel Habe ich diesen Pfad angegen C:\Produkte\(A)Auto
Userbild

Vielleicht habe ich mein anliegen zu umständlich erklärt. Ich versuche nochmal ein Beispiel zu geben.
Ich habe folgenden (original) Pfad:
C:\Produkte\ hier sind ca.20 Ordner enthalten von denen aber nur 6 St. für die Listbox interessant sind
Die original Ordner für die Abfrage heißen so:
C:\Produkte\(A)Auto
C:\Produkte\(B)Bekleidung
C:\Produkte\(D)Deko
C:\Produkte\(J)Jacken
C:\Produkte\(R)Rucksack
C:\Produkte\(S)Schuhe
Ordner wie z.b
C:\Produkte\Rechnungen
C:\Produkte\Einkauf
sind uninteressant
In jedem dieser "Kategorieordner" befindet sich "Artikelordner" die immer mit dem Anfangsbuchstaben der jeweiligen Kategorie beginnen und von 001 fortlaufend nach oben gezählt werden.
C:\Produkte\(A)Auto\A033
C:\Produkte\(B)Bekleidung\B025
C:\Produkte\(D)Deko\D035
C:\Produkte\(J)Jacken\J056
C:\Produkte\(R)Rucksack\R069
C:\Produkte\(S)Schuhe\S128
Wird das UserForm also gestartet soll der Code die 6 Ordner durchschauen und die höchste Zahl ermitteln, diese dann mit 1 addieren und wie folgt in der Listbox ausgeben.
A034
B026
D036
J057
R070
S129
Der Mitarbeiter kann dann seine gewünschte Artikelnummer auswählen und seine Daten im Rest des Formulares eingeben, am Ende erzeugt ein Druck auf Speichern den Artikelordner der aus der Liste ausgewählt worden ist in der gewünschten Kategorie (das habe ich schon fertig).
Es ist wichtig, dass die Auswahl des nächsten Freien Ordners über eine Abfrage erfolgt da teilweise auch manuell neue Ordner erstellt werden und eventell nicht in einer Tabelle gepflegt werden.
Ich verbleibe mit freundlichen Grüßen und hoffe du kannst mir helfen
Andreas Schachtl

Hallo Andres,
ich hatte mich bei der Erstellung des Makros an der Ordner-Struktur in deiner ursprünglichen Frage orientiert.
Ich hab das Makro jetzt angepasst.
Alle Ordner deren Name mit ( beginnt werden jetzt weiter durchsucht.
Der Buchstabe zwischen den beiden Klammern wird als 1. Buchstabe für Unterordner mit Artikelnummern genommen.
LG
Franz

Private Sub UserForm_Activate()
'nächste neuen Ordner ermitteln
Dim arrOrdnerNeu() As String, arrOrdner(), iCount As Integer
Dim FSO As Object             'FileSystemObject
Dim fsoFolder As Object       'Folder
Dim fsoSubfolder1 As Object   'Folder
Dim fsoSubfolder2 As Object   'Folder
Dim Nr_Max As Integer, Nr_File As Integer, strBuchstabe As String
Set FSO = CreateObject("Scripting.FileSystemObject")
Set fsoFolder = FSO.GetFolder("C:\Users\Public\Test\Mathias") 'Hauptordner - anpassen!!!!!
iCount = 0
'1. Ebene der Unterordner im Hauptordner abarbeiten
For Each fsoSubfolder1 In fsoFolder.SubFolders
'prüfen, ob Ordnername mit "(" beginnt
If Left(fsoSubfolder1.Name, 1) = "(" Then
'2. Buchstaben des Ordnernamens als 1. Buchstaben für die Namen der Unterordner nehmen
strBuchstabe = Mid(fsoSubfolder1.Name, 2, 1)
Nr_Max = 0
If fsoSubfolder1.SubFolders.Count = 0 Then
'Ordner hat noch keinen unterordner
Else
'Ordner mit der größten Zählnummer in Unteordner der Ebene 2 ermitteln
For Each fsoSubfolder2 In fsoSubfolder1.SubFolders
Nr_File = Val(Right(fsoSubfolder2.Name, 3))
If Nr_File > Nr_Max Then Nr_Max = Nr_File
Next
End If
iCount = iCount + 1
ReDim Preserve arrOrdnerNeu(1 To iCount)
ReDim Preserve arrOrdner(1 To iCount)
Nr_Max = Nr_Max + 1
arrOrdner(iCount) = fsoSubfolder1.Path
arrOrdnerNeu(iCount) = strBuchstabe & Format(Nr_Max, "000")
End If
Next
'Auswahl für neue Ordner in Listbox übertragen
With Me.ListBox1  'Namen der Listbox ggf. anpassen
.Clear
.ColumnCount = 2
.ColumnWidths = "50Pt;0Pt" 'der zugehörige Unterordner wird in der Listbox in der 2. Spalte  _
erfasst, aber nicht angezeigt
For iCount = LBound(arrOrdnerNeu) To UBound(arrOrdnerNeu)
.AddItem arrOrdnerNeu(iCount)
.List(.ListCount - 1, 1) = arrOrdner(iCount)
Next
End With
End Sub

Beliebteste Forumthreads (12 Monate)

nächsten freien Ordnernamen suchen

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

117 Forumthreads zu ähnlichen Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

nächsten freien Ordnernamen suchen

6 Beiträge zum Forumthread Beiträge zu diesem Forumthread

117 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread