Live-Forum - Die aktuellen Beiträge
Datum
Titel
26.04.2024 08:08:24
Pivot Vormonatsveränderung
26.04.2024 07:54:11
nur den ersten Eintrag in spalte zählen
25.04.2024 23:47:55
Datum ausweisen, wenn definierte Summe erreicht ist
25.04.2024 21:40:53
Excel Datenquelle aus dem Web mit Anmeldung?
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1612to1616
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1612to1616
1612to1616
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Finde Unterordner (1.Ebene) welche nicht leer sind

Finde Unterordner (1.Ebene) welche nicht leer sind
18.03.2018 08:01:26
Tinu
Guten Tag
Ich möchte im Verzeichnis F:\Liste alle
Unterordner (nur 1. Ebene) durchsuchen und eine Liste aller Unterverzeichnisse ausgeben,
welche nicht leer sind. Resp. alternativ einen bestimmten Dateityp enthalten.
(zB *.mdb - Dateien)
F:Liste\1
F:Liste\5
F:Liste\77
F:Liste\997
weitere Unterordner sollen von der Suche ausgeschlossen sein.
z.B F:Liste\997\zweiteEbene
Vielleicht hat da jemande einen VBA-Code. Im Internet habe ich zwar allerlei gefunden,
aber entweder durchsucht es sämtliche Unterverzeichnisse oder listet einfach alles auf.
Besten Dank
Tinu Kiefer

5
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Finde Unterordner (1.Ebene) welche nicht leer sind
18.03.2018 08:10:40
Sepp
Hallo Tinu,
probier mal.
Modul Modul1 
Option Explicit 
 
Sub subFolders() 
  Dim objFSO As Object, objFolder As Object, objSubFolder As Object 
  Dim lngRow As Long 
 
  Const cstrPath As String = "F:\Liste" 
 
  Set objFSO = CreateObject("Scripting.FileSystemObject") 
  Set objFolder = objFSO.GetFolder(cstrPath) 
 
  With Sheets("Tabelle1") 'Ausgabetabelle - Anpassen! 
    .Range("A:A") = "" 
    For Each objSubFolder In objFolder.subFolders 
      If objSubFolder.Files.Count > 0 Then 
        lngRow = lngRow + 1 
        .Cells(lngRow, 1) = objSubFolder.Path 
      End If 
    Next 
  End With 
 
  Set objFolder = Nothing 
  Set objFSO = Nothing 
End Sub 


VBA/HTML-CodeConverter, AddIn für Office 2002-2016 - in VBA geschrieben von Lukas Mosimann. Projektbetreuung:RMH Software & Media
Code erstellt und getestet in Office 16 - mit VBAHTML 12.6.0
 AB
1Gruß Sepp
2Windows 10 64 bit
3Office 365 32 bit

Anzeige
AW: Finde Unterordner (1.Ebene) welche nicht leer sind
18.03.2018 10:47:09
Tinu
Wow, das ging flott!
Sepp, Herzlichen Dank !
AW: Finde Unterordner (1.Ebene) welche nicht leer sind
18.03.2018 17:50:34
Tinu
noch eine Anschlussfrage,
wie kann ich die Abfrage erweitern, wenn ich nur Unterordner
listen will, die eine *.mdb Datei enthalten?
Gruss
Tinu
AW: Finde Unterordner (1.Ebene) welche nicht leer sind
18.03.2018 18:06:23
Sepp
Hallo Tinu,
das geht dann z.B. so.
Modul Modul1 
Option Explicit 
 
Sub subFolders() 
  Dim objFSO As Object, objFolder As Object, objSubFolder As Object 
  Dim lngRow As Long 
 
  Const cstrPath As String = "F:\Liste" 
 
  Set objFSO = CreateObject("Scripting.FileSystemObject") 
  Set objFolder = objFSO.GetFolder(cstrPath) 
 
  With Sheets("Tabelle1") 'Ausgabetabelle - Anpassen! 
    .Range("A:A") = "" 
    For Each objSubFolder In objFolder.subFolders 
      If objSubFolder.Files.Count > 0 Then 
        If Dir(objSubFolder.Path & "\*.mdb", vbNormal) <> "" Then 
          lngRow = lngRow + 1 
          .Cells(lngRow, 1) = objSubFolder.Path 
        End If 
      End If 
    Next 
  End With 
 
  Set objFolder = Nothing 
  Set objFSO = Nothing 
End Sub 


VBA/HTML-CodeConverter, AddIn für Office 2002-2016 - in VBA geschrieben von Lukas Mosimann. Projektbetreuung:RMH Software & Media
Code erstellt und getestet in Office 16 - mit VBAHTML 12.6.0
 AB
1Gruß Sepp
2Windows 10 64 bit
3Office 365 32 bit

Anzeige
AW: Finde Unterordner (1.Ebene) welche nicht leer sind
18.03.2018 23:44:49
Tinu
Top!
Merci Sepp

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige