Unterordner per VBA auflisten.

[Carlos_C]

Guten Morgen, liebes Forum

Ich habe eine Frage gemäß Auflistung von Datei-Ordnernamen in Excel:

Ich möchte auf Buttomclick in Excel 2007 von einem bestimmten Ordner (C:\Ordner), alle Unterordner (aber nur die von der ersten Ebene, also nur die Ordner, die man sehen kann, wenn man doppelclick auf "C:\Ordner" macht) in einer Spalte auflisten. Ich habe gestern lange rumgegoogelt aber leider nichts gefunden.

Ich freue mich auf jeden Vorschlag!

Liebe Grüße,

Carlos

[daolix]

Hier mal nen Bsp.

Code [Auswählen] Erweitern

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 * 14
End Type


Private Declare Function FindFirstFile Lib "KERNEL32.DLL" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As DirData) As Long
Private Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" (ByVal hFindFile As Long, lpFindFileData As DirData) As Long
Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long

Private Const INVALID_HANDLE_VALUE = -1

Private Sub CommandButton1_Click()
    Dim i As Long, sPath As String
    Dim WFD As DirData, hFile As Long, lRet As Long
    sPath = "C:\*.*"
    hFile = FindFirstFile(sPath, WFD)
    If hFile <> INVALID_HANDLE_VALUE Then
        Do
            If (WFD.dwFileAttributes And vbDirectory) = 16 And Not _
               (WFD.dwFileAttributes And vbHidden) = vbHidden Then
                i = i + 1
                Debug.Print WFD.dwFileAttributes
                Me.Cells(i, 1) = Left$(WFD.cFileName, InStr(1, WFD.cFileName, vbNullChar) - 1)
            End If
        Loop While FindNextFile(hFile, WFD) <> 0
        FindClose hFile
    End If
End Sub

[Carlos_C]

Wunderbar! Vielen Dank, Daolix! Hat sehr gut geklappt!

Eine Frage noch: Kann man die Prozedur modifizieren, um alle Dateinamen (sei Ordner oder Dateien) aufzulisten?

LG

Carlos

[daolix]

ja in etwa so

Code [Auswählen] Erweitern

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 * 14
End Type


Private Declare Function FindFirstFile Lib "KERNEL32.DLL" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As DirData) As Long
Private Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" (ByVal hFindFile As Long, lpFindFileData As DirData) As Long
Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long

Private Const INVALID_HANDLE_VALUE = -1

Private Sub CommandButton1_Click()
    Dim i As Long, sPath As String
    Dim WFD As DirData, hFile As Long, lRet As Long
    sPath = "C:\*.*"
    hFile = FindFirstFile(sPath, WFD)
    If hFile <> INVALID_HANDLE_VALUE Then
        Do
            If Not (WFD.dwFileAttributes And vbHidden) = vbHidden Then
                i = i + 1
                Me.Cells(i, 1) = Left$(WFD.cFileName, InStr(1, WFD.cFileName, vbNullChar) - 1)
            End If
        Loop While FindNextFile(hFile, WFD) <> 0
        FindClose hFile
    End If
End Sub


Eine Frage noch: Kann man die Prozedur modifizieren, um alle Dateinamen (sei Ordner oder Dateien) aufzulisten?

Wenn dies soundso dein Ziel war dann kann man das ganze auch mit VBA machen und nicht mit Api's, der Code ist kürzer, also alles oben mit nachfolgenden Code ersetzen:

Code [Auswählen] Erweitern

Private Sub CommandButton1_Click()
    Dim s As String, i as long
    s = Dir$("c:\", vbNormal Or vbDirectory)
    Do While Len(s) > 0
         i = i + 1
         Me.Cells(i, 1) = s
        s = Dir$
    Loop
End Sub

[Carlos_C]

Hallo Daolix

Ich habe letztere probiert.

Die Prozedur schreibt zuerst ,,." Und dann kommt folgende Fehlermeldung:

Laufzeitfehler '5':
Ungültiger Prozeduraufruf oder ungültiges Argument

Und das System markiert das ,, s = Dir$ ,,.

Was haben wir falsch gemacht??

[daolix]

hmm eigentlich sollte es laufen, bei mir zumindest tut es das, aber ich habe auch "nur" die 2003'er Version von Excel/Office. nimm mal das "$" -Zeichen in den beiden Dir$ - Zeilen raus, evtl stört er sich daran.

[Carlos_C]

Danke, Daolix! Funktioniert aber nicht. Gibt es nicht eine andere Prozedur, mit der man alle Dateienamen und Ordnernamen aufliste, die sich in einem Ordner befinden?

Gruß,

Carlos

[DF6GL]

Hallo,

WAS funktioniert denn nicht?


Statt nach einer anderen Funktion zu suchen, solltest Du den vorgeschlagenen Code zum Laufen bringen...


Bei mir funktioniert der (kurze Code) jedenfalls auf Anhieb. 


Möglicherweise müssen bei Dir die Datei als  als "Mappe mit Makros" (*.xlsm) gespeichert und  die Sicherheitseinstellungen  angepasst werden.


Vertrauensstellungscenter
      vertrauenswürdige Speicherorte
     Einstellungen für Makros  (alle Makros aktivieren -- Zugriff auf VBA vertrauen)
               

[Carlos_C]

Hat nach tausende Versuche funktioniert! Danke, jungs! Gruß, Carlos.