Readdy Write  
0,00 €
Your View Money
Views: Count
Self 20% 0
Your Content 60% 0

Users by Links 0
u1*(Content+Views) 10% 0
Follow-Follower 0
s2*(Income) 5% 0

Count
Followers 0
Login Register as User

Access Excel: Sortiert Liste mit Dateien

10.03.2019 (👁1368)


 

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