Access-o-Mania

Office-Forum (Deutsch/German) => Microsoft Excel => Thema gestartet von: Carlos_C am November 30, 2011, 09:46:44

Titel: Unterordner per VBA auflisten.
Beitrag von: Carlos_C am November 30, 2011, 09:46:44
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
Titel: Re: Unterordner per VBA auflisten.
Beitrag von: daolix am November 30, 2011, 13:31:52
Hier mal nen Bsp.
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



Titel: Re: Unterordner per VBA auflisten.
Beitrag von: Carlos_C am November 30, 2011, 14:38:18
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
Titel: Re: Unterordner per VBA auflisten.
Beitrag von: daolix am November 30, 2011, 15:15:59
ja in etwa so
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




ZitatEine 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:

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



Titel: Re: Unterordner per VBA auflisten.
Beitrag von: Carlos_C am November 30, 2011, 15:41:23
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??
Titel: Re: Unterordner per VBA auflisten.
Beitrag von: daolix am November 30, 2011, 16:01:45
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.
Titel: Re: Unterordner per VBA auflisten.
Beitrag von: Carlos_C am Dezember 07, 2011, 08:32:05
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
Titel: Re: Unterordner per VBA auflisten.
Beitrag von: DF6GL am Dezember 07, 2011, 12:50:19
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)
               
Titel: Re: Unterordner per VBA auflisten.
Beitrag von: Carlos_C am Januar 23, 2012, 15:08:31
Hat nach tausende Versuche funktioniert! Danke, jungs! Gruß, Carlos.