nur Hauptordner auflisten

[ecki62]

Hallo liebe Wissende,

ich finde einfach nichts.
Ich möchte per VBA in Excel nur die obersten Ordner, also
H:\K1
H:\K2
usw
und nicht
H:\K1
H:\K1\nochmehr
in einer Excel-Tabelle auflisten.
Ich finde nur etwas, dass mir alles einschließlich Unterordner ausliest und leider kann ich diese Codes nicht so abändern, dass nur der oberste Ordner gelistet wird.
Weiß jemand Rat?
Vielen Dank im Voraus.
Gruß Ekchard

[Kuwer]

Hallo Ekchard,

Sub ListeOrdner()
  Dim strOrdner As String
  Dim strPfad As String
' Namen in H:\ anzeigen, die Verzeichnisse darstellen.
  strPfad = "H:\"    ' Pfad setzen.
  strOrdner = Dir(strPfad, vbDirectory)    ' Ersten Eintrag abrufen.
  Do While strOrdner <> ""    ' Schleife beginnen.
      ' Aktuelles und übergeordnetes Verzeichnis ignorieren.
      If strOrdner <> "." And strOrdner <> ".." Then
          ' Mit bit-weisem Vergleich sicherstellen, daß strOrdner ein
          ' Verzeichnis ist.
          If (GetAttr(strPfad & strOrdner) And vbDirectory) = vbDirectory Then
              ' Eintrag nur anzeigen, wenn es sich um ein Verzeichnis handelt.
              Cells(Rows.Count, 1).End(xlUp).Offset(1).Value = strOrdner
          End If
      End If
      strOrdner = Dir    ' Nächsten Eintrag abrufen.
  Loop
End Sub

Gruß Uwe

[Storax]

Oder mal mit ADODB

[ecki62]

Vielen Dank.

Und sogar mit Erklärung. Da werde ich mal dran arbeiten.

Ach ja - und es funktioniert.

[00202]

Hallo, :19:

Alternativ mit dem "Scripting.FileSystemObject": :21:

Code:

Option Explicit
Public Sub Main()
    Dim objFolder As Object, objSubfolder As Object, rngRange As Range
    Set objFolder = CreateObject("Scripting.FileSystemObject").GetFolder("C:\") ' C evtl. ANPASSEN!!!
    For Each objSubfolder In objFolder.SubFolders
        If objSubfolder.Attributes = 16 Then
            Set rngRange = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1)
            rngRange = objSubfolder.Name: Set rngRange = Nothing
        End If
    Next objSubfolder
End Sub

Ähnlich wie Uwe mit "Dir":

Code:

Option Explicit
Public Sub Main_1()
    Dim strTMP As String, lngTMP As Long
    strTMP = Dir$("C:\", vbDirectory) ' C evtl. ANPASSEN!!!
    Do While Len(strTMP) > 0
        If InStr(strTMP, ".") = 0 Then lngTMP = lngTMP + 1: Cells(lngTMP, 1) = strTMP
        strTMP = Dir$
    Loop
End Sub

Mit "API":

Code:

Option Explicit
Private Type FILETIME
    dwLowDateTime As Long
    dwHighDateTime As Long
End Type
Private Type DirData
    dwFileAttributes As Long
    ftCreationTime As FILETIME
    ftLastAccessTime As FILETIME
    ftLastWriteTime As FILETIME
    nFileSizeHigh As Long
    nFileSizeLow As Long
    dwReserved0 As Long
    dwReserved1 As Long
    cFileName As String * 260
    cAlternate As String * 16
End Type
Private Declare PtrSafe Function FindFirstFile Lib "kernel32.dll" Alias "FindFirstFileA" _
    (ByVal lpFileName As String, ByRef lpFindFileData As DirData) As LongPtr
Private Declare PtrSafe Function FindNextFile Lib "kernel32.dll" Alias "FindNextFileA" _
    (ByVal hFindFile As LongPtr, ByRef lpFindFileData As DirData) As LongPtr
Private Declare PtrSafe Function FindClose Lib "kernel32.dll" (ByVal hFindFile As LongPtr) As LongPtr
Private Const FAULT = -1
Public Sub Main_2()
    Dim lngRow&, strPath$, lngFile&
    Dim datFileDir As DirData
    strPath = "C:\*.*" ' C evtl. ANPASSEN!!!
    lngFile = FindFirstFile(strPath, datFileDir)
    If lngFile <> FAULT Then
        Do
            If (datFileDir.dwFileAttributes And vbDirectory) = 16 And Not _
                (datFileDir.dwFileAttributes And vbHidden) = vbHidden Then
                lngRow = lngRow + 1
                Cells(lngRow, 1) = Left$(datFileDir.cFileName, InStr(1, datFileDir.cFileName, vbNullChar) - 1)
            End If
        Loop While FindNextFile(lngFile, datFileDir) <> 0
        FindClose lngFile
    End If
End Sub

Über die Attribute kannst du dann noch etwas steuern (Systemordner/Versteckte...).

[Kuwer]

Hi Ralf,

Ähnlich wie Uwe mit "Dir":

das aber nicht unbedingt besser ist, da Ordnernamen, welche Punkte enthalten, nicht aufgelistet werden.  

Gruß Uwe

[00202]

Hallo Uwe, :19:

da falle ich immer wieder drauf rein. Da es bei uns keine Ordner mit Umlauten, "ß" oder sonstige ominöse Zeichen gibt (ein Punkt gehört bei mir auch dazu), klappen meine Tests natürlich immer anstandslos.

Aber ich habe ja noch zwei weitere Alternativen gezeigt. :05:

[Gast 123]

Hallo Uwe + hallo Case

ich sehe da gerade schöne Codes zum auflisten von Ordnern. Dazu ganz höflich eine technische Frage von mir:

Wie gross ist der Laufzeit Unterschied, bei den verschiedenen Codes, wenn man ein ganzes Laufwerk D auflisten will, mit über 1000 Videos und MP3 Dateien, wo man auch die Video Laenge, Bildschirmgrösse und MP3 Merkmale mit auflisten möchte??  Mein uraltes Internet Programm braucht dafür über 10-15 Minuten.

Habt ihr dafür auch eine Idee, und einen Code den ich verstehen kann ...   würde mich sehr freuen!
(Falls gewünscht kann ich das auch als neuen Thread aufmachen)

mfg Gast 123

[schauan]

Hallöchen,

zum Thema mp3 gibt's auch was von mir, siehe hier
MP3-Tag-listen-und-bearbeiten-WMA-listen
und da
MP3-Lister-Player-Playlist

Die Laufzeit(unterschiede) kannst Du mit der API getTickCount ermitteln:
http://www.xltips.de/ftxt/vba-api/systemzeit_bas.html

[Gast 123]

Hallo Schauan

ich hab mir die Beispiele heruntergeladen und schau sie mir in Ruhe an. Danke für deine Bemühungen ...

mfg Gast 123