Microsoft Excel

Herbers Excel/VBA-Archiv

VBA Paar Fragen(Leere Ordner/unterverzeichnis)

Betrifft: VBA Paar Fragen(Leere Ordner/unterverzeichnis) von: sam
Geschrieben am: 04.09.2014 12:57:23

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 IOS funktioniert.
    lg Sam :)

      

    Betrifft: AW: VBA Paar Fragen(Leere Ordner/unterverzeichnis) von: sam
    Geschrieben am: 04.09.2014 13:35:53

    IOS= apple sry...