Microsoft Excel

Herbers Excel/VBA-Archiv

nächsten freien Ordnernamen suchen

Betrifft: nächsten freien Ordnernamen suchen von: Andreas
Geschrieben am: 01.08.2020 14:54:06

Hallo zusammen,


ich stoße langsam an meine Grenzen, auch mehrstündiges suchen im Internet hatte nicht den gewünschten erfolg. Vielleicht könnt Ihr mir helfen.


Beim klicken auf einen Button soll ein neuer Ordner erstellt werden (das ist noch nicht das Problem).

Das Problem ist die ListBox, aus dieser möchte Ich den nächsten freien Ordnernamen einer bestimmten Kategorie auswählen.


Beispiel:


Ordener Struktur:


C:\Test Hauptordner

C:\Test\A\A001 älterer Ordner

C:\Test\A\A002 der zuletzt erstellte Ordner

C:\Test\B\B001 älterer Ordner

C:\Test\B\B002 der zuletzt erstellte Ordner

C:\Test\C\C001 älterer Ordner

C:\Test\C\C002 der zuletzt erstellte Ordner

C:\Test\D\D001 älterer Ordner

C:\Test\D\D002 der zuletzt erstellte Ordner

C:\Test\E\E001 älterer Ordner

C:\Test\E\E002 der zuletzt erstellte Ordner

usw.


Die Listbox soll also folgendes zur Auswahl Anzeigen


A003

B003

C003

D003

E003


Ich wähle z.b. D003 aus und klicke auf meinen Button, dieser erstellt mir diesen Ordner

C:\Test\D\D003


Beim nächsten öffnen der Userform soll mir die Listbox dann das anbieten:


A003

B003

C003

D004 da der zuletzt erstellte Ordner D003 ist

E003


ich hoffe das mir geholfen werden kann.



Gruß Andreas

Betrifft: dann erhöhe doch einfach jeweils um +1
von: Matthias L
Geschrieben am: 01.08.2020 16:36:54

.

Betrifft: AW: dann erhöhe doch einfach jeweils um +1
von: Andreas
Geschrieben am: 02.08.2020 22:40:11

Der Tipp hilft mir leider nicht weiter. Ich habe Probleme die Namen der in den Ordner befindlichen Ordner auszulesen und dann am Ende eben nur den zuletzt erstellten Ordner in einer listbox darzustellen. Darauf soll immer mit 1 darauf gezählt werden...

Hier nochmal ein anderes Beispiel

Ausgegeben werden sollen diese beiden Ordnernamen am besten in einer ListBox einer UserForm

z.b.
C:\Test\A001 (erstellt am 01.01.2020)
C:\Test\A002 (erstellt am 07.01.2020
C:\neuerTest\B001 (erstellt am 01.01.2020)
C:\neuerTest\B002 (erstellt am 08.01.2020)

A003 und B003 soll dann in der ListBox angezeigt werden.

Ich hoffe, ich konnte es verständlich beschreiben.

Gruß Andreas

Betrifft: AW: nächsten freien Ordnernamen suchen
von: fcs
Geschrieben am: 04.08.2020 21:52:37

Hallo Andreas,

hier ein Beispiel für eine entsprechende Ereignis-Prozedur "UserForm_Activate".

In der Auswahlliste der Listbox wird neben dem neu anzulegenden Ordnernamen auch das zugehörige übergeordnete Verzeichnis in der 2. Spalte erfasst - aber nicht dargestellt.

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


Betrifft: AW: nächsten freien Ordnernamen suchen
von: Andreas
Geschrieben am: 05.08.2020 16:56:42

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



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

Betrifft: AW: nächsten freien Ordnernamen suchen
von: fcs
Geschrieben am: 05.08.2020 18:29:19

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


Betrifft: AW: nächsten freien Ordnernamen suchen
von: Andreas
Geschrieben am: 05.08.2020 19:41:00

WoooW!
Klasse Absolut genau das was ich gesucht habe!
Vielen dank für deine Hilfe.
Das mit der suche nach "(" ist genial, so kann ich ohne Probleme neue "Kategorieordner" anlegen

Danke und gruß Andreas