Dateilisten in eine Tabell schreiben

Informationen und Beispiele zu den hier genannten Dialog-Elementen:


Excel-Version: 2000
nach unten

Betrifft: Dateilisten in eine Tabell schreiben
von: Christian Gafert
Geschrieben am: 09.05.2002 - 00:14:27

Hallo,
ich muss alle Dateien in einem Verzeichnis auflisten. Da es sich um über 10.000 handelt, möchte ich dies nicht "per hand" erledigen.
Wer kann mir helfen?
Danke, Christian

nach oben   nach unten

Re: Dateilisten in eine Tabell schreiben
von: Jürgen
Geschrieben am: 09.05.2002 - 00:27:44

kopier mal folgenden Code in ein Modul und rufe das Makro Suchen auf!


Public Type BROWSEINFO                                                                       '
     hOwner As Long
     pidlRoot As Long
     pszDisplayName As String
     lpszTitle As String
     ulFlags As Long
     lpfn As Long
     lParam As Long
     iImage As Long
End Type                                                                                     '
Declare Function SHGetPathFromIDList Lib "shell32.dll" _
Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
Declare Function SHBrowseForFolder Lib "shell32.dll" _
Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long
Private z!
Sub Dateisuche(Laufwerk, Dateien)
    Dim tmp, Wdhlg, Dateiname As String
    On Error Resume Next
    If Right(Laufwerk, 1) <> "\" Then Laufwerk = Laufwerk + "\"
    tmp = Dir(Laufwerk & Dateien)
    Do While Len(tmp)
        Dateiname = Laufwerk & tmp
        Application.StatusBar = Dateiname
        Cells(z, 1).Select
        Cells(z, 1) = Laufwerk & tmp                'Pfad
        Cells(z, 2) = FileLen(Laufwerk & tmp)       'Größe
        Cells(z, 3) = FileDateTime(Laufwerk & tmp)  'Datum/Zeit
        Cells(z, 4) = tmp                           'nur Dateiname
        z = z + 1
        tmp = Dir()
    Loop
    tmp = Dir(Laufwerk, vbDirectory)
    Do While Len(tmp)
       If (tmp <> ".") And (tmp <> "..") Then
          If (GetAttr(Laufwerk & tmp) And vbDirectory) = vbDirectory Then
             Dateisuche Laufwerk & tmp, Dateien
             z = z - 1
             Wdhlg = Dir(Laufwerk, vbDirectory)
             z = z + 1
             Do While Wdhlg <> tmp
                Wdhlg = Dir()
             Loop
          End If
       End If
       tmp = Dir()
    Loop
   On Error GoTo 0
   Application.StatusBar = False
End Sub
Sub Suchen()
Dim Laufwerk$, Dateien$
    z = 2
    [a2:e50000] = ""
    Laufwerk = GetDirectory("Bitte einen Ordner wählen")
    If Laufwerk = "" Then Exit Sub
    Dateien = InputBox("Nach welchen Dateien soll in" & Chr(10) & "      " & Laufwerk & Chr(10) & "gesucht werden (z. B. *.xls)?", "Dateityp", "*.*")
    If Dateien = "" Then Exit Sub
    Dateisuche Laufwerk, Dateien
End Sub
Function GetDirectory(Msg) As String
    Dim bInfo As BROWSEINFO
    Dim path As String
    Dim As Long, x As Long, pos As Integer
    With bInfo
        .pidlRoot = 0&
        .lpszTitle = Msg
        .ulFlags = &H1
    End With
    x = SHBrowseForFolder(bInfo)
    path = Space$(512)
    r = SHGetPathFromIDList(ByVal x, ByVal path)
    If r Then
        pos = InStr(path, Chr$(0))
        GetDirectory = Left(path, pos - 1)
    Else
        GetDirectory = ""
    End If
End Function

nach oben   nach unten

erschlagen !?
von: th.heinrich
Geschrieben am: 09.05.2002 - 01:31:18

hallo Juergen

wieso dieser CODE ??

ist sicher keine hilfe.

trotzdem schoenen vatertag ;-)

gruss thomas


nach oben   nach unten

Re: Dateilisten in eine Tabell schreiben
von: geri
Geschrieben am: 09.05.2002 - 15:43:38

etwas kürzer.kopiere in Modul und passe Pfad, LW noch an

Sub Dateiliste_Öffnen()

Dim strVerzeichnis As String
Dim StrDatei As String
Dim I As Integer
Dim StrTyp As String
Dim Dateiname As String
Dim Aktuell_Datei As String
Dim Aktuell_Register As String

Aktuell_Datei = ActiveWorkbook.Name
Aktuell_Register = ActiveSheet.Name

' von hier werden die Daten geholt
strVerzeichnis = "C:\daten\"

'StrTyp = "*.xls" für Auswahl von Suffix
StrTyp = "*.*"

Dateiname = Dir(strVerzeichnis & StrTyp)
I = 3
Do While Dateiname <> ""
'Cells(I, 1).Value = strVerzeichnis & Dateiname (wenn Path nötig diese Zeile)
Cells(I, 1).Value = Dateiname ' (ohne Path)
I = I + 1
Dateiname = Dir
Loop
End Sub

gruss
geri

 nach oben

Beiträge aus den Excel-Beispielen zum Thema "Dateilisten in eine Tabell schreiben"