Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1380to1384
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
Inhaltsverzeichnis

Leere Ordner finden und Unterverzeichnis

Leere Ordner finden und Unterverzeichnis
04.09.2014 20:08:31
sam

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

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Leere Ordner finden und Unterverzeichnis
05.09.2014 18:17:22
Franc
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

Anzeige
AW: Leere Ordner finden und Unterverzeichnis
05.09.2014 18:23:23
Franc
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

Anzeige
AW: Leere Ordner finden und Unterverzeichnis
06.09.2014 15:43:46
Hajo_Zi
warum offen, Du hast doch eine Lösung gepostet. Lasse den Fragesteller entscheiden ob offen.

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige