Live-Forum - Die aktuellen Beiträge
Datum
Titel
29.03.2024 13:14:12
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1872to1876
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Ordnerauflistung unsortiert

Ordnerauflistung unsortiert
10.03.2022 17:15:05
Andreas
Hallo Zusammen,
ich suche eine kleine Hilfestellung. Mit unten stehendem Code durchsuche ich verschiedene Ordner (2016,2017,2018....). Alle Dateien in diesen Ordner
werden in einer Liste angezeigt. Die Dateinamen beginnen immer mit der Jahreszahl, d.h. für z.B. 2016 lautet die erste Datei 1601 für 2017 dann 1701 usw.
Bis dato wurde die Liste auch immer korrekt dargestellt, d.h. in Reihenfolge 1601,1602,1603,1604 etc.. Seit gestern jedoch würfelt er die Dateien in der Listbox
durcheinander. Die Dateien in den jeweiligen Ordner sind auch nach Name sortiert.
Gibt es hier eine Lösung die Dateien nochmals bei auslesen zu sortieren?
Danke

Option Explicit
Private Sub CommandButton1_Click()
Dim objWorkbook As Workbook
Dim lngIndex As Long
Call Hide
Application.ScreenUpdating = False
For lngIndex = 0 To ListBox1.ListCount - 1
With ListBox1
If .Selected(pvargIndex:=lngIndex) Then
Set objWorkbook = Workbooks.Open(Filename:= _
.List(pvargIndex:=lngIndex, pvargColumn:=1) & _
.List(pvargIndex:=lngIndex, pvargColumn:=0))
With objWorkbook
Call .Worksheets(.Worksheets.Count).Select
Application.Run ("'" & .Name & "'!Daten_holen_Bewertung_Vorjahre")
'Call Run(Macro:=.Name & "!NeuesBlatt")
Call .Worksheets(.Worksheets.Count).PrintOut
Call .Close(SaveChanges:=True)
End With
End If
End With
Next
Application.ScreenUpdating = True
MsgBox "Fertig !"
CommandButton2.Value = True
End Sub
Private Sub CommandButton2_Click()
Call Unload(Object:=Me)
End Sub
Private Sub UserForm_Initialize()
Const FOLDER_PATH As String = "\\NAS-2T\Bau\Projekte\Verschoben auf Server\0005 Baustellenbewertungen\" 'anpassen !!!
Dim lngYear As Long
Dim strFileName As String
For lngYear = 2016 To 2030
strFileName = Dir$(PathName:=FOLDER_PATH & CStr(lngYear) & "\*.xlsm")
Do Until strFileName = vbNullString
With ListBox1
Call .AddItem(pvargItem:=strFileName)
.List(.ListCount - 1, 1) = FOLDER_PATH & CStr(lngYear) & "\"
.Selected(pvargIndex:=.ListCount - 1) = False
End With
strFileName = Dir$
Loop
Next
End Sub

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

Betreff
Datum
Anwender
Anzeige
AW: Ordnerauflistung unsortiert
10.03.2022 17:53:25
Nepumuk
Hallo Andreas,
teste mal:

Option Explicit
Option Compare Text
Private Enum SORT_TYPE
Text
Date
Number
End Enum
Private Enum SORT_ORDER
Ascending
Descending
End Enum
Private Sub CommandButton1_Click()
Dim objWorkbook As Workbook
Dim lngIndex As Long
Call Hide
Application.ScreenUpdating = False
With ListBox1
For lngIndex = 0 To ListBox1.ListCount - 1
If .Selected(pvargIndex:=lngIndex) Then
Set objWorkbook = Workbooks.Open(Filename:= _
.List(pvargIndex:=lngIndex, pvargColumn:=1) & _
.List(pvargIndex:=lngIndex, pvargColumn:=0))
With objWorkbook
Call .Worksheets(.Worksheets.Count).Select
Call Application.Run("'" & .Name & "'!Daten_holen_Bewertung_Vorjahre")
'Call Run(Macro:=.Name & "!NeuesBlatt")
Call .Worksheets(.Worksheets.Count).PrintOut
Call .Close(SaveChanges:=True)
End With
End If
Next
End With
Application.ScreenUpdating = True
MsgBox "Fertig !"
CommandButton2.Value = True
End Sub
Private Sub CommandButton2_Click()
Call Unload(Object:=Me)
End Sub
Private Sub UserForm_Initialize()
Const FOLDER_PATH As String = "\\NAS-2T\Bau\Projekte\Verschoben auf Server\0005 Baustellenbewertungen\" 'anpassen !!!
Dim lngYear As Long
Dim strFileName As String
Dim avntList As Variant
With ListBox1
For lngYear = 2016 To 2030
strFileName = Dir$(PathName:=FOLDER_PATH & CStr(lngYear) & "\*.xlsm")
Do Until strFileName = vbNullString
Call .AddItem(pvargItem:=strFileName)
.List(.ListCount - 1, 1) = FOLDER_PATH & CStr(lngYear) & "\"
.Selected(pvargIndex:=.ListCount - 1) = False
strFileName = Dir$
Loop
Next
avntList = .List
Call QuickSort(LBound(avntList), UBound(avntList), 1, Ascending, Text, avntList)
.List = avntList
End With
End Sub
Private Sub QuickSort(ByVal pvlngLbound As Long, ByVal pvlngUbound As Long, _
ByVal pvlngSortColumn As Long, ByVal pvenmSortOrder As SORT_ORDER, _
ByVal pvenmDatatType As SORT_TYPE, ByRef pravntArray As Variant)
Dim intIndex As Integer
Dim lngIndex1 As Long, lngIndex2 As Long
Dim vntTemp As Variant, vntBuffer As Variant
lngIndex1 = pvlngLbound
lngIndex2 = pvlngUbound
Select Case pvenmDatatType
Case Text
vntBuffer = CStr(pravntArray((pvlngLbound + pvlngUbound) \ 2, pvlngSortColumn))
Case Date
vntBuffer = CDate(pravntArray((pvlngLbound + pvlngUbound) \ 2, pvlngSortColumn))
Case Number
vntBuffer = CDec(pravntArray((pvlngLbound + pvlngUbound) \ 2, pvlngSortColumn))
End Select
Do
Select Case pvenmDatatType
Case Text
If pvenmSortOrder = Ascending Then
Do While CStr(pravntArray(lngIndex1, pvlngSortColumn))  vntBuffer
lngIndex1 = lngIndex1 + 1
Loop
Do While vntBuffer > CStr(pravntArray(lngIndex2, pvlngSortColumn))
lngIndex2 = lngIndex2 - 1
Loop
End If
Case Date
If pvenmSortOrder = Ascending Then
Do While CDate(pravntArray(lngIndex1, pvlngSortColumn))  vntBuffer
lngIndex1 = lngIndex1 + 1
Loop
Do While vntBuffer > CDate(pravntArray(lngIndex2, pvlngSortColumn))
lngIndex2 = lngIndex2 - 1
Loop
End If
Case Number
If pvenmSortOrder = Ascending Then
Do While CDec(pravntArray(lngIndex1, pvlngSortColumn))  vntBuffer
lngIndex1 = lngIndex1 + 1
Loop
Do While vntBuffer > CDec(pravntArray(lngIndex2, pvlngSortColumn))
lngIndex2 = lngIndex2 - 1
Loop
End If
End Select
If lngIndex1  _
pravntArray(lngIndex2, pvlngSortColumn) Then
For intIndex = LBound(pravntArray, 2) To UBound(pravntArray, 2)
vntTemp = pravntArray(lngIndex1, intIndex)
pravntArray(lngIndex1, intIndex) = _
pravntArray(lngIndex2, intIndex)
pravntArray(lngIndex2, intIndex) = vntTemp
Next
End If
lngIndex1 = lngIndex1 + 1
lngIndex2 = lngIndex2 - 1
ElseIf lngIndex1 = lngIndex2 Then
lngIndex1 = lngIndex1 + 1
lngIndex2 = lngIndex2 - 1
End If
Loop Until lngIndex1 > lngIndex2
If pvlngLbound 
Gruß
Nepumuk
Anzeige
AW: Ordnerauflistung unsortiert
11.03.2022 08:48:29
Andreas
Hallo Nepumuk,
danke für deine Hilfe. Leider klappt es immer noch nicht (s. Bild).
Ich vermute es liegt an unserem NAS, da bis dato der vorhanden Code immer funktioniert hat.
Userbild
AW: Ordnerauflistung unsortiert
11.03.2022 09:08:20
Nepumuk
Hallo Andreas,
hast du den Code im UserForm_Initialize-Event übernommen?
Gruß
Nepumuk
AW: Ordnerauflistung unsortiert
11.03.2022 09:46:29
Andreas
Hallo Nepumuk,
ja. habe den Code komplett übernommen.
Leider klappt es nicht.
Gruß
Andreas
AW: Ordnerauflistung unsortiert
11.03.2022 10:05:35
Nepumuk
Hallo Andreas,
ändere diese Zeile:
Call QuickSort(LBound(avntList), UBound(avntList), 1, Ascending, Text, avntList)
so:
Call QuickSort(LBound(avntList), UBound(avntList), 0, Ascending, Text, avntList)
Gruß
Nepumuk
Anzeige
AW: Ordnerauflistung unsortiert
11.03.2022 10:39:00
Andreas
Hallo Nepumuk,
vielen Dankf für deine Hilfe. Jetzt klappt es!
Danke Andreas

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige