daten aus Laufwerk lesen

Forumthread: daten aus Laufwerk lesen

07.10.2004 13:36:20

jürg

Hallo Forum
habe ein VBA das ich erweitert haben möchte. und zwar möchte ich vom laufwerk c ein scibt starten das mir alle Dateien aus einem andern Laufwerk auflistet. Kann man volgendes scribt anpassen?


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

vielen Dank
mit gruss
jürg

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: daten aus Laufwerk lesen

dan

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

AW: daten aus Laufwerk lesen

07.10.2004 15:19:59

jürg

hallo dan
schalle das nicht kannst du das etwas verständlicher beschreiben?
danke

AW: daten aus Laufwerk lesen

dan

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

AW: daten aus Laufwerk lesen

jürg

danke Dan
es hat funktioniert!!
mit gruss
Jürg

Beliebteste Forumthreads (12 Monate)

Forumthread: daten aus Laufwerk lesen

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

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread