title image


Smiley Aulistung aller Unterordner eines auszuwählenden Ordners
Hallo Anton,



hier ein kleines Beispiel, kopiere den folgenden VBA-Code in ein Modul und starte das Makro "OrdnerAuflisten" :





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



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

        [A1] = "Unterordner des Ordners " & Suchpfad & ":"

        Set fs = CreateObject("Scripting.FileSystemObject")

        Set f = fs.GetFolder(Suchpfad)

        Set sf = f.SubFolders

        zeile = 2

        For Each f1 In sf

            Cells(zeile, 1) = f1.Name

            zeile = zeile + 1

        Next

    End If

End Sub







Code eingefügt mit Syntaxhighlighter 2.4





Leider hast Du nicht angegeben, ob Du alle Ordner inkl. dessen Unterordner auflisten möchtes oder nur die direkten Unterordner der 1.Ebene.

Das Makro listet bisher nur die direkten Unterordner ohne dessen weiterer Unterordner in Spalte A auf.

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: