Ordnerstruktur

[Andyle]

Sorry, aber zu manchen Beiträgen braucht man wirklich nichts mehr sagen.

Glaub es gibt andere Foren in denen Neulinge nicht dumm gemacht werden.

[Egon12]

@snb,
wie wäre es noch zusätzlich mit /o.
Da hat man gleich ein schon ganz brauchbar sortiertes Ergebnis.
 
@Andyle,
für dumm will dich mit Sicherheit keiner hier hinstellen. Die knackigste Lösung ist die von snb. Diese ist eben nicht leicht zu lesen bzw. zu verstehen.
Da kann man sich aber belesen. Das meiste sind eh nur DIR Optionen aus MS-Dos.
Die Split Funktion teilt/trennt die Funde in ArrayZellen auf.
Naja und noch Haupt- und Unterverzeichnisse mit > bzw. >> zu kennzeichnen ist eigentlich wenig sinnig.

Gruß Uwe

[juvee]

Hi,

vielleicht hilft dir ja dieses Makro

Tabelle und Startverzeichnis anpassen

Code:

Option Explicit
Private lrow As Long, lcol As Long
Private Const strStartFolder = "E:\"    'anpassen!!!
Private wks As Worksheet

Sub verlinkeVerzeichnis()
    Dim FSO As Object, FS As Object

    Set FSO = CreateObject("scripting.filesystemobject")
    Set FS = FSO.getfolder(strStartFolder)
   
    Set wks = ThisWorkbook.Worksheets(2)  ' anpassen!!!!!!!
      wks.UsedRange.Clear
      lrow = wks.Cells(Rows.Count, 1).End(xlUp).Row
      lcol = 1
      wks.Cells(lrow, 1) = strStartFolder
           
      recTree FS, True ' true -->einschließlich Unterverzeichnisse, sonst nur Verzeichnisse
   
    Set FSO = Nothing
    Set FS = Nothing
    Set wks = Nothing
    End Sub
Public Sub recTree(ByVal objFolder As Object, Optional blnSubfolder As Boolean = False)
      Dim sf As Object, f As Object
   
      If blnSubfolder = True Then
        lcol = lcol + 1
        lrow = lrow + 1
          Call listFiles(objFolder, lrow, lcol + 1)
        For Each sf In objFolder.subfolders
          If sf.Name <> "System Volume Information" And sf.Name <> "$RECYCLE.BIN" Then
            wks.Hyperlinks.Add Cells(lrow, lcol + 1), sf.Path, , , sf.Path
            Call recTree(sf, True)
          End If
        Next
        lcol = lcol - 1
      Else
        For Each sf In objFolder.subfolders
          If sf.Name <> "System Volume Information" And sf.Name <> "$RECYCLE.BIN" Then
            lrow = lrow + 1
            wks.Hyperlinks.Add Cells(lrow, lcol + 1), sf.Path, , , sf.Path
          End If
        Next
      End If
    End Sub

Sub listFiles(ByVal objFolder As Object, ByRef zeile As Long, spalte As Long)
Dim f As Object, arr As Variant, i As Long
If objFolder.Files.Count Then
ReDim arr(1 To objFolder.Files.Count)
For Each f In objFolder.Files
    i = i + 1
    arr(i) = f.Name
Next
    wks.Cells(zeile, spalte).Resize(UBound(arr)) = Application.Transpose(arr)
    zeile = zeile + UBound(arr)
End If
End Sub

[Andyle]

@ juvee


Vielen dank, dieses Script habe ich bereits.

Nützt mir allerdings nichts.

[Gast 123]

Hallo

auf die Gefahr hin mich lächerlich zu machen schicke ich dir mal eine uralte Datei, die gut funktioniert.
Wie du siehst liste ich mir die Unterordner seitlich als Baumstruktur auf!  Da sieht man die Struktur.
Hilft dir das weiter???   Ich errechne nur wieviel \ im Pfad vorkommen und setze *3 Space davor!

mfg Gast 123

[snb]

Warum so kompliziert ?

Code:

Dim c01

Sub M_snb()
  M_snb_000 "D:\"
  MsgBox c01
End Sub

Sub M_snb_000(c00)
  On Error Resume Next
  With CreateObject("scripting.filesystemobject").getfolder(c00)
    For Each it In .subfolders
      c01 = c01 & vbLf & Replace(Replace(it.Path, ":\", ">>>"), "\", ">>")
      M_snb_000 it.Path
    Next
  End With
End Sub

[Egon12]

@snb

und deine 1. Version das Array einfach so?

Code:

sp(i, 0) = Replace(Replace(sn(i), ":\", ">"), "\", ">>")

Gruß Uwe

[Gast 123]

Hallo

@snb   man sieht immer wieder das du mit deinen kurzen Codes der wahre Fachmann im Forum bist.
            Freut mich das du meine Idee die Baumstruktur so zu machen wesentlich verbessert hast.

mfg Gast 123

[snb]

@egon

Ja, oder:

Code:

Sub M_snb()
  sn=Split(replace(replace(CreateObject("wscript.shell").Exec("cmd /c dir G:\*.* /b /a-d /s").StdOut.ReadAll, ":\",">>>"),"\",">>"),vbCrLf)
  redim sp(ubound(sn),0)

  for j=0 to ubound(sn)
    sp(j,0)=sn(j)
  next
  cells(1).resize(ubound(sn)+1)=sp
End Sub

[Egon12]

habe noch eine weitere Idee dazu:

Code:

sn = Split(Replace(Replace(CreateObject("wscript.shell").Exec("cmd /c dir " & Pfad & "\" & " *.* /b /a-d /s /o").StdOut.ReadAll, ":\", ">"), "\", ">>"), vbCrLf)
Tabelle1.Cells(1, 1).Resize(UBound(sn), 1) = Application.Transpose(sn)

eigentlich wollte ich einen 1-Zeiler draus machen, aber dann ist die Zeile so sperrig, dass man es kaum mehr lesen kann.

Gruß Uwe