Supportnet / Forum / Tabellenkalkulation

Ich möchte verschieden Verzeichnisse auf meiner FP in einem Excel Arbeitsblatt auflisten. Hierbei möchte ich auswählen, ob nur die Verzeichnisse aufgelistet werden sollen oder ob auch die darin enthaltenen Dateine aufgelistet werden sollen. Gibt es hierfür ein Makor? Oder wie bekomme ich die Verzeichnisse in ein Arbeitsblatt? Danke

Hallo,

dieses Makro von Jörg Lorenz finde ich sehr gut:

Option Explicit

'#############################
 'Dieser Bereich kann entfallen,
 'wenn der Variable 'Laufwerk'
 'ein fester Wert zugewiesen wird.
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!

'Ruft das Dialogfeld zur Ordnerauswahl auf
Function GetDirectory(Msg) As String
Dim bInfo As BROWSEINFO
Dim path As String
Dim r 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

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

'Aufruf mit dem folgenden Makro
Sub Suchen()
Dim Laufwerk$, Dateien$
'Ersze Zeile, in der eine Eintragung erfolgt
z = 2
'Alte Eintragungen löschen
[a1:e5000] = ""
'Den Variablen Laufwerk und Dateien kann
'auch ein direkter Wert zugewiesen werden.
'Ersatz: ... = "C:\Eigene Dateien"
Laufwerk = GetDirectory("Bitte einen Ordner wählen")
If Laufwerk = "" Then Exit Sub
'Ersatz: Dateien = "*.*"
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

Quelle:
http://www.excel-vba.de/ordneruebergreifend.htm#auslesen

Gruß
Günter

• Excel-Dateien mit internen Verknüpfungen kopieren
• Excel Makro in viele Excel Files exportieren
• Excel: Link über Pfad (Makro)
• Aktueller Ordner soll Standardordner sein!