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