In diesem vba Code Beispiel wird gezeigt, wie man eine sortierte Liste mit Dateien erstellen kann.
Normalerweise wird über FileSystemObject in der Micosoft Makro Sprache vba einfach immer eine Liste an Dateien in einem Verzeichnis zurückgegeben.
Man kann die Liste leider nicht sortieren.
Deshalb hier der Trick: man kann in allen Office Anwendungen (Access, Excel Word, Outlook PowerPoint) die Liste der Dateien mit einem integrierten Ado Objekt zur Laufzeit erstellen
Betrifft: Filesystemobject, Array Ado List
Sortierte Liste in vba
Man erstellt eine Ado Tabelle zur Laufzeit
|
'< create_ado_Table > Dim sorted_List As ADODB.Recordset Set sorted_List = CreateObject("ADODB.Recordset") sorted_List.CursorLocation = 3 ' adUseClient sorted_List.Fields.Append "FileName", 200, 50 ' adVarChar sorted_List.Fields.Append "Date_Created", 7 ' adDate sorted_List.Open '</ create_ado_Table >
|
Dann fügt man Elemente hinzu
|
'< add_line > sorted_List.AddNew sorted_List("FileName").Value = sFilename sorted_List("Date_Created").Value = dtFile sorted_List.Update '</ add_line > |
Dann sortiert man die Liste
|
'< sort > sorted_List.Sort = "[Date_Created] DESC" sorted_List.MoveFirst '</ sort > |
Und gibt die Ergebnisse aus
|
'--< @Loop: Output >-- Do Until sorted_List.EOF ctlListe_Files.AddItem (sorted_List("FileName") & ";" & sorted_List("Date_Created")) sorted_List.MoveNext Loop '--</ @Loop: Output >-- |
Hierzu benötigt man unter Menü->Verweise die
Micosoft Scripting Runtime
Und
Microsoft ActiveX Data Objects x Library
|
Public Sub Load_Files_by_Date() '-------------< Load_Files_by_Date() >----------- On Error Resume Next ctlListe_Files.RowSource = ""
Dim Folder_Path As String Folder_Path = CurrentProject.Path & "\Testfiles"
'--< Get_Folder >-- Dim objFileSystem As New FileSystemObject 'using Microsoft Scripting Runtime Dim objFolder As Folder
'< check > If objFileSystem.FolderExists(Folder_Path) = False Then MsgBox "Subfolder \Testfiles does not exitst", vbCritical, "check" Exit Sub End If '</ check >
'--< Get_Folder >-- Set objFolder = objFileSystem.GetFolder(Folder_Path) '--</ Get_Folder >--
'----</ Files ermitteln >----
'< List_Header > ctlListe_Files.AddItem ("File;Date") '</ List_Header >
'< create_ado_Table > Dim sorted_List As ADODB.Recordset Set sorted_List = CreateObject("ADODB.Recordset") sorted_List.CursorLocation = 3 ' adUseClient sorted_List.Fields.Append "FileName", 200, 50 ' adVarChar sorted_List.Fields.Append "Date_Created", 7 ' adDate sorted_List.Open '</ create_ado_Table >
On Error GoTo 0
'------< @Loop: Files_in_Folder >------ Dim objFile As File For Each objFile In objFolder.Files 'get_Files If Not objFile.ShortName Like "*.LNK" Then '< init > Dim sFilename As String sFilename = objFile.Name
Dim dtFile As String dtFile = objFile.DateCreated '</ init >
'< add_line > sorted_List.AddNew sorted_List("FileName").Value = sFilename sorted_List("Date_Created").Value = dtFile sorted_List.Update '</ add_line > End If Next '------</ @Loop: Files_in_Folder >------
'< sort > sorted_List.Sort = "[Date_Created] DESC" sorted_List.MoveFirst '</ sort >
'--< @Loop: Output >-- Do Until sorted_List.EOF ctlListe_Files.AddItem (sorted_List("FileName") & ";" & sorted_List("Date_Created")) sorted_List.MoveNext Loop
'--</ @Loop: Output >--
'< final > Set objFile = Nothing Set objFolder = Nothing Set objFileSystem = Nothing '</ final >
'-------------</ Load_Files_by_Date() >----------- End Sub
|
Normales Füllen einer Liste by Name
|
Option Compare Database Option Explicit
Private Sub BtnLoad_Click() Load_Files_by_Name End Sub Private Sub BtnLoad_Sorted_Click() Load_Files_by_Date End Sub
Public Sub Load_Files_by_Name() '-------------< Load_Files_by_Name() >----------- On Error Resume Next ctlListe_Files.RowSource = ""
Dim Folder_Path As String Folder_Path = CurrentProject.Path & "\Testfiles"
'--< Get_Folder >-- Dim objFileSystem As New FileSystemObject 'using Microsoft Scripting Runtime Dim objFolder As Folder
'< check > If objFileSystem.FolderExists(Folder_Path) = False Then MsgBox "Subfolder \Testfiles does not exitst", vbCritical, "check" Exit Sub End If '</ check >
'--< Get_Folder >-- Set objFolder = objFileSystem.GetFolder(Folder_Path) '--</ Get_Folder >--
'----</ Files ermitteln >----
'< List_Header > ctlListe_Files.AddItem ("File;Date") '</ List_Header >
On Error GoTo 0
'------< @Loop: Files_in_Folder >------ Dim objFile As File For Each objFile In objFolder.Files 'get_Files '< init > Dim sFilename As String sFilename = objFile.Name
Dim dtFile As String dtFile = objFile.DateCreated '</ init >
'< add_line > ctlListe_Files.AddItem (sFilename & ";" & dtFile) '</ add_line > Next '------</ @Loop: Files_in_Folder >------
'< final > Set objFile = Nothing Set objFolder = Nothing Set objFileSystem = Nothing '</ final >
'-------------</ Load_Files_by_Name() >----------- End Sub
|
CodeDodu.de
