title image


Smiley Aulistung aller Unterordner eines Ordners - mit oder ohne Rekursion
Hallo Anton,



ich habe das Makro entsprechend erweitert, hier der Code :





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



Public Zeile, Suchpfad



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



Function GetDirectory(Optional Msg As String) As String

    Dim bInfo As BROWSEINFO

    Dim Path As String

    Dim r As Long, x As Long, pos As Integer

    bInfo.pidlRoot = 0&

    If IsMissing(Msg) Then

        bInfo.lpszTitle = "Wählen Sie bitte einen Ordner aus."

    Else

        bInfo.lpszTitle = Msg

    End If

    bInfo.ulFlags = &H1

    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 OrdnerAuflisten()

    Suchpfad = GetDirectory("Bitte einen beliebigen Ordner auswählen:")

    If Suchpfad <> "" Then

        Zeile = 1

        Cells(Zeile, 1) = "Unterordner des Ordners " & Suchpfad & ":"

        Zeile = Zeile + 1

        Cells(Zeile, 1) = Suchpfad

        Call Unterordner(Suchpfad, Rekursiv:=True)  'Rekursiv=TRUE: mit Unterordner / FALSE=Ohne

    End If

End Sub



Sub Unterordner(Ordner, Optional Rekursiv)

        Set fs = CreateObject("Scripting.FileSystemObject")

        Set f = fs.GetFolder(Ordner)

        Set sf = f.SubFolders

        For Each f1 In sf

            Zeile = [a65536].End(xlUp).Row + 1

             Cells(Zeile, 1) = Ordner & "\" & f1.Name

             If Rekursiv = True Then Call Unterordner(Ordner & "\" & f1.Name, True)

        Next

End Sub











Über die Option "Rekursiv:=TRUE" oder "Rekursiv:=FALSE" kannst Du nun steuern, ob alle untergeordneten Ordner mit aufgelistet werden sollen oder nicht.

Grüße, NoNet

  1,2,3 - kleine Excelei :   Infos + Anmeldung zum Jährlichen Exceltreffen



geschrieben von

Login

E-Mail:
  

Passwort:
  

Beitrag anfügen

Symbol:
 
 
 
 
 
 
 
 
 
 
 
 
 

Überschrift: