VBA Paar Fragen(Leere Ordner/unterverzeichnis)

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