daten aus Laufwerk lesen

Sub DateiListe() Dim FName$, TMP$ Dim FileArray() Dim ProcessCounter%, FCount%, i% 'Dim Datum Application.ScreenUpdating = False 'Datum = InputBox("Ab wann?") 'If Datum = "" Then Exit Sub On Error GoTo ErrorHandler 'Datum = CDate(Datum) FName = Dir("H:\Daten\*.*") Do While FName <> "" If FileDateTime(FName) > Datum Then FCount = FCount + 1 ReDim Preserve FileArray(1 To FCount) FileArray(FCount) = FName FName = Dir() End If Loop For ProcessCounter = 1 To FCount TMP = FileArray(ProcessCounter) i = i + 1 Worksheets(1).Cells(i, 1) = Left _ (TMP, Len(TMP) - 4) Worksheets(1).Cells(i, 2) = Format _ (FileDateTime(TMP), "dd.mm.yy") Next ErrorHandler: End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Juerg, hier ein Code, das ehnlich arbeitet, nur mit dem FileSystemObject. In der Const FOLDER_NAME kann man den Folder aendern. Gruss Dan.

Option Explicit
Private Const FOLDER_NAME As String = "C:\WINNT\"
Public Sub DateiListe()
    Dim Fso As Object
    Dim Fld As Object
    Dim Fle As Object
    Dim Row As Long
    Dim Col As Integer
    Dim ShActive As Worksheet


    Set Fso = VBA.CreateObject("Scripting.FileSystemObject")
    If (Fso.FolderExists(FOLDER_NAME) = True) Then
        Set Fld = Fso.getfolder(FOLDER_NAME)
    Else
        MsgBox "Folder " & FOLDER_NAME & " existiert nicht!"
        End
    End If

    Set ShActive = ActiveSheet

    Row = 1
    Col = 1

    If (Not ShActive Is Nothing) Then

        On Error GoTo Err_DateiListe

        For Each Fle In Fld.Files
           ShActive.Cells(Row, Col).Value = Fle.Name
           ShActive.Cells(Row, Col + 1).Value = Fle.Type
           ShActive.Cells(Row, Col + 2).Value = Fle.DateCreated
           Row = Row + 1
        Next Fle

    Else

        MsgBox "Kein aktives Blatt!"
        End

    End If

    Exit Sub

Err_DateiListe:
    If (Err.Number = 70) Then
        ShActive.Cells(Row, Col).Value = FOLDER_NAME & " - Permission denied"
    Else
        MsgBox Err.Description, vbCritical, "Fehler " & Err.Number
    End If

    End
End Sub

Hallo, ich habe es versucht, den Code zu komentieren, hoffentlich kannst Du es jetzt besser verstehen. Gruss Dan, CZ [DDMAIL@seznam.cz]
------------------------------------------------------------------------------------

Option Explicit
' hier sollte man den Folder, aus dem man die Dateien auflisten will, z.B C:\ oder anderes
Private Const FOLDER_NAME As String = "C:\WINNT\"
Public Sub DateiListe()
    Dim Fso As Object          ' benutzt man fur die Referentz auf FileSystemObject
    Dim Fld As Object          ' benutzt man fur die Referentz auf Folder (Ordner)
    Dim Fle As Object          ' benutzt man fur die Referentz auf File (Datei)
    Dim Row As Long            ' benutzt man fur die Variable fuer die Zeile
    Dim Col As Integer         ' Variable fuer die Spalte
    Dim ShActive As Worksheet  ' Referntz auf den Sheet, in den man die Dateinamen schreiben wird

    ' wenn es zu einem Fehler kommt, wird der Code hinter dieser Label ausgefuehrt :
    On Error GoTo Err_DateiListe

    ' man muss den FileSystemObject bilden :
    Set Fso = VBA.CreateObject("Scripting.FileSystemObject")

    ' Test, ob der Ordner, den man durchsuchen will existiert :
    If (Fso.FolderExists(FOLDER_NAME) = True) Then
        ' wenn ja, dann eine Referentz auf ihn setsen :
        Set Fld = Fso.getfolder(FOLDER_NAME)
    Else
        ' wenn nicht, eine Nachricht einblenden und Makro beenden
        MsgBox "Folder " & FOLDER_NAME & " existiert nicht!"
        End
    End If

    ' eine Referentz auf den aktiven Blatt setsen,
    ' in diesen Blatt werden die Dateinemen geschrieben :
    Set ShActive = ActiveSheet

    ' Variablen initialisieren, also man beginnt in der 1.Zeile, und in der 1.Spalte
    Row = 1
    Col = 1

    ' Test, ob der Aktive Blatt existiert,
    ' weil wenn z.B. alle Dateienfenster hidden sein werden, wird es keinen aktiven Blatt geben
    ' aber hier kann man es auch anders machen, z.B. :
'    Dim wrbNew As Workbook
'    Set wrbNew = Application.Workbooks.Add
'    Set ShActive = wrbNew.Worksheets(1)
    If (Not ShActive Is Nothing) Then

        ' hier geht man die Collection des Files in dem Folder durch
        For Each Fle In Fld.Files
            ' und fuer jeden File (Datei) wird in den ShActive folgendes gesrieben :
            ShActive.Cells(Row, Col).Value = Fle.Name ' der Name der Datei
            ShActive.Cells(Row, Col + 1).Value = Fle.Type ' der Typ
            ShActive.Cells(Row, Col + 2).Value = Fle.DateCreated ' und Datum der Entsteung der Datei
            ' und man bewegt sich auf die naechste Zeile, um den weiteren Namen schreiben zu koennen
            Row = Row + 1
        Next Fle

    Else

        MsgBox "Kein aktives Blatt!"
        End

    End If

    Exit Sub

Err_DateiListe:
    ' Fehler Nummer 70 entschteht, wenn man nicht ausreichende Rechte auf den Folder hat
    If (Err.Number = 70) Then
        ShActive.Cells(Row, Col).Value = FOLDER_NAME & " - Permission denied"
    Else
        MsgBox Err.Description, vbCritical, "Fehler " & Err.Number
    End If

    End
End Sub

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

daten aus Laufwerk lesen

4 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread