Microsoft Excel

Herbers Excel/VBA-Archiv

Leere Ordner finden und Unterverzeichnis

Betrifft: Leere Ordner finden und Unterverzeichnis von: sam
Geschrieben am: 04.09.2014 20:08:31

Moin,
zu erst ein Mal ich habe die Mac 2011 Version. Das konnte ich leider nicht auswählen.
Jetzt zu meinem Problem. Ich habe mir ein VBA Makro gesucht und es ein bisschen angepasst.
Option Explicit
Option Base 1
Dim folders() As String, files() As String, foldersname() As String, filesname() As String
Dim filecount As Integer, foldercount As Integer
Dim mypath

Sub GetFiles()
Dim myfile
filecount = 0
myfile = Dir("")
Do
If Left(myfile, 1) <> "." Then
filecount = filecount + 1
ReDim Preserve files(filecount)
ReDim Preserve filesname(filecount)
files(filecount) = CurDir() & Application.PathSeparator & myfile
filesname(filecount) = myfile
End If
myfile = Dir()
Loop Until myfile = ""
End Sub

Sub Getfolders()

Dim mydir

mypath = Application.ActiveWorkbook.Path & Application.PathSeparator

foldercount = 0

mydir = Dir("", vbDirectory)

Do

If mydir = "." Or mydir = ".." Then GoTo continue

If GetAttr(mypath & mydir) = vbDirectory Then

foldercount = foldercount + 1

ReDim Preserve folders(foldercount)

ReDim Preserve foldersname(foldercount)

folders(foldercount) = mypath & mydir

foldersname(foldercount) = mydir



End If

continue:

mydir = Dir()

Loop Until mydir = ""

End Sub

Sub DateienUndOrdner()

Dim fcount As Integer

Getfolders

GetFiles



With Worksheets("Liste")

Application.ScreenUpdating = False



  'Range leeren

  .Range("A:B").ClearContents

  'Überschriften setzen

  .Range("A1").Value = "Ordner"

  .Range("B1").Value = "Dateien"



'Folder listen

If foldercount > 0 Then

  For fcount = LBound(folders) To UBound(folders)

  .Hyperlinks.Add Anchor:=.Range("A1").Offset(fcount, 0), _

  Address:=folders(fcount), _

  TextToDisplay:=foldersname(fcount)

    Next fcount

End If



'Dateien listen

If filecount > 0 Then

  For fcount = LBound(files) To UBound(files)

  .Hyperlinks.Add Anchor:=.Range("B1").Offset(fcount, 0), _

  Address:=files(fcount), _

  TextToDisplay:=filesname(fcount)

  Next fcount

.Columns("A:B").EntireColumn.AutoFit

End If



Application.ScreenUpdating = True

End With

End Sub

Dazu habe ich ein paar Fragen und ich würde mich tierisch freuen, wenn die mir jemand beantworten würde. Ich habe schon sehr lange viel gesucht.
Wenn If GetAttr(mypath & mydir) = vbDirectory Then stimmt, warum handelt es sich dann um einen Ordner?
Ich möchte eig. nur Leere Ordner in folders() rein schreiben. Ich hatte überlegt wenn ich ein Ordner gefunden habe, in den Ordner zu wechseln mit ChDir und zu gucken ob dort Datein drin sind. Wenn dort Datein drin sind, wollte ich da weiter nach Ordnern suchen und wenn er leer ist, ihn einfach in folders() rein schreiben. Habe ich aber leider nicht hinbekommen. Ich finde auch keine Funktion die mir die Größe eines Ordners zurück gibt. Also Ich will unterverzeichnisse durchsuchen können und nur Leere Ordner auflisten.

Es wäre noch wichtig, dass das Makro unter windows und apple funktioniert.
lg Sam :)

  

Betrifft: AW: Leere Ordner finden und Unterverzeichnis von: Franc
Geschrieben am: 05.09.2014 18:17:22

GetAttr(Ordner/Datei) liefert einen Wert zurück.
Bei einem Ordner ist es "16" bzw. "vbDirectory"
Ergo wird das in der if then schleife nur ausgeführt, wenn als Wert vom Pfad ein Ordner erkannt wird. Bei einer Datei liefert er bei mir immer den Wert 32 = vbArchive zurück.

Um zu sehen ob ein Ordner leer ist, kannst folgendes nutzen.
Bei If GetAttr(mypath & mydir) = vbDirectory Then
schreibst

"if Dir(mypath & mydir & "\*.*") = "" then"
das liefert dir alle Dateinamen in dem Verzeichnis und wenn keine drin sind, dann gibt es nichts also "" zurück
Das \ steht vor dem *.*, weil mydir nur den Verzeichnisnamen ohne das \ dahinter enthält.

Bei der Else Anweisung bin ich mir grad nicht ganz sicher aber sollte schon richtig sein.
Der prüft ja ob Array Filename(aktuelle pos) ein Verzeichnis ist und wenn das nicht der Fall ist, dann überschreibt er das nicht leere Verzeichnis mit dem nächsten Wert.
Lass dire Frage aber sicherheitshalber mal offen ^^

If GetAttr(mypath & mydir) = vbDirectory Then
If Dir(mypath & mydir & "\*.*") = "" Then
foldercount = foldercount + 1
ReDim Preserve folders(foldercount)
ReDim Preserve foldersname(foldercount)
folders(foldercount) = mypath & mydir
foldersname(foldercount) = mydir
Else
folders(foldercount) = mypath & mydir
foldersname(foldercount) = mydir
End If
End If


  

Betrifft: AW: Leere Ordner finden und Unterverzeichnis von: Franc
Geschrieben am: 05.09.2014 18:23:23

ich hasse es ^^
der nimmt alle tabs raus damit es "schön" aussieht noch mal das ganze Makro.

Sub Getfolders()

Dim mydir

foldercount = 0
mydir = Dir("", vbDirectory)
mypath = Application.ActiveWorkbook.Path & Application.PathSeparator

Do
    If mydir = "." Or mydir = ".." Then GoTo continue
    
    If GetAttr(mypath & mydir) = vbDirectory Then
        If Dir(mypath & mydir & "\*.*") = "" Then
            foldercount = foldercount + 1
            ReDim Preserve folders(foldercount)
            ReDim Preserve foldersname(foldercount)
            folders(foldercount) = mypath & mydir
            foldersname(foldercount) = mydir
        Else
            folders(foldercount) = mypath & mydir
            foldersname(foldercount) = mydir
        End If
    End If

continue:

mydir = Dir()

Loop Until mydir = ""

End Sub



  

Betrifft: AW: Leere Ordner finden und Unterverzeichnis von: Hajo_Zi
Geschrieben am: 06.09.2014 15:43:46

warum offen, Du hast doch eine Lösung gepostet. Lasse den Fragesteller entscheiden ob offen.

GrußformelHomepage


 

Beiträge aus den Excel-Beispielen zum Thema "Leere Ordner finden und Unterverzeichnis"