Subordnerpfade aus mehreren Ordner auslesen

Forumthread: Subordnerpfade aus mehreren Ordner auslesen

21.06.2014 12:19:25

Jack

Hallo Leute,
folgendes:
Mein Ziel wäre es mehrere Verzeichnisse: z.B
K:\Ordner1
K:\Ordner2
K:\Ordner3
auszulesen und dessen Subordner(am besten mit kompletten Pfad z.B. "K:\Ordner1\Bla") in Excel auflistet
Sodass am Ende, das bei rauskommt:
K:\Ordner1\Bla1
K:\Ordner1\Bla2
K:\Ordner1\Bla3
K:\Ordner2\EE1
K:\Ordner2\EE2
K:\Ordner2\EE3
K:\Ordner3\TT1
Habe zwar schon rumgesucht, aber noch nicht das passende gefunden, das unten kommt dem schon _ Nahe allerdings ist das Makro auf ein Verzeichnis beschränkt und gibt nur den Subordner Namen wieder.


Sub HD1Ordnername_einlesen()
Dim objFSO As Object
Dim objFolder As Object
Dim strPfad As String
Dim objSubfolder As Object, colSubfolders As Object
Dim lngNext As Long
strPfad = "K:\Ordner1"
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(strPfad)
Set colSubfolders = objFolder.Subfolders
lngNext = Application.Max(2, Cells(Rows.Count, 1).End(xlUp).Row + 1)
For Each objSubfolder In colSubfolders
If IsError(Application.Match(objSubfolder.Name, Columns(1), 0)) Then
Cells(lngNext, 1).Value = objSubfolder.Name
lngNext = lngNext + 1
End If
Next objSubfolder
Set objFolder = Nothing
Set colSubfolders = Nothing
Set objFSO = Nothing
End Sub

Vielen Danke im Vorraus fürs durchlesen und ggf. eine Lösung.. wäre super nett von euch!
mfg
Daze

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Subordnerpfade aus mehreren Ordner auslesen

21.06.2014 13:07:15

ransi

HAllo
Schau dir mal dies an:

' **********************************************************************
' Modul: Tabelle1 Typ: Element der Mappe(Sheet, Workbook, ...)
' **********************************************************************

Option Explicit

Dim zaehler As Long
Dim arr
Public Sub Aufruf()
    Dim objShell As Object
    Dim objFolder As Object
    Dim objItem As Object
    Redim arr(0)
    Set objShell = CreateObject("Shell.Application")
    With objShell
        Set objFolder = .BrowseForFolder(0&, "Was soll ich machen?", 0)
    End With
    If Not objFolder Is Nothing Then
        Set objItem = objFolder.Self
        arr(0) = objItem.Path
        Else: Exit Sub
    End If
    Schreiben objItem.Path, True 'True wenn die Unterordner auch wieder geschrieben werden sollen.
    'Sonst False oder weglassen. Entspricht SearchSubfolders
    Range("a1").Resize(UBound(arr)) = WorksheetFunction.Transpose(arr) 'ausgeben
    zaehler = 0
End Sub

Public Sub Schreiben(Suchordner, Optional sbfolds As Boolean = False)
    Dim fso As Object
    Dim datei
    Dim Unterordner
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set datei = fso.getfolder(Suchordner)
    On Error Resume Next
    Select Case sbfolds
        Case True
            For Each Unterordner In datei.subfolders
                zaehler = zaehler + 1
                Redim Preserve arr(zaehler)
                arr(zaehler) = Unterordner.Path
                Schreiben Unterordner, True
            Next
        Case False
            For Each Unterordner In datei.subfolders
                zaehler = zaehler + 1
                Redim Preserve arr(zaehler)
                arr(zaehler) = Unterordner.Path
            Next
    End Select
    Set fso = Nothing
    Set datei = Nothing
End Sub

ransi

AW: Subordnerpfade aus mehreren Ordner auslesen

21.06.2014 13:16:31

Daniel

Sub HD1Ordnername_einlesen()
Dim objFSO As Object
Dim objFolder As Object
Dim strPfad, PfadListe
Dim objSubfolder As Object, colSubfolders As Object
Dim lngNext As Long
PfadListe = Array("K:\Ordner1", "K:\Ordner2", "K:\Ordner3")
lngNext = Application.Max(2, Cells(Rows.Count, 1).End(xlUp).Row + 1)
For Each strPfad In PfadListe
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(strPfad)
Set colSubfolders = objFolder.Subfolders
For Each objSubfolder In colSubfolders
If IsError(Application.Match(objSubfolder.Name, Columns(1), 0)) Then
Cells(lngNext, 1).Value = strPfad & "\" & objSubfolder.Name
lngNext = lngNext + 1
End If
Next objSubfolder
Next strPfad
Set objFolder = Nothing
Set colSubfolders = Nothing
Set objFSO = Nothing
End Sub

Gruß Daniel

AW: Subordnerpfade aus mehreren Ordner auslesen

21.06.2014 14:16:59

Jack

Hey,
Danke für die Antworten, klappt super Daniel!
Besteht die Möglichkeit die Liste nach den Subordnern alphabetisch zu sortieren? Nur wenn es nicht zuviel Aufwand erfordert, Danke !
z.B:
C:\Ordner2\AFFE
K:\Ordner1\Bla2
K:\Ordner1\Zig
K:\Ordner2\ZZZ

AW: Subordnerpfade aus mehreren Ordner auslesen

21.06.2014 14:30:26

Daniel

Da die Ergebnisse in einer Excelspalte stehen, machst du das hinterher mit der sortierfunktion von Excel:

columns(1).Sort Key1:=cells(1, 1), order1:=xlascending, Header:=xlguess

Gruß Daniel

Beliebteste Forumthreads (12 Monate)

Subordnerpfade aus mehreren Ordner auslesen

Forumthread: Subordnerpfade aus mehreren Ordner auslesen

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Subordnerpfade aus mehreren Ordner auslesen

Forumthread: Subordnerpfade aus mehreren Ordner auslesen

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

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread