Leere Ordner finden und Unterverzeichnis

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