Verzeichnisse und Unterverzeichnisse auslesen

Function SHGetPathFromIDList Lib "shell32.dll" _
Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
Declare 

Function SHBrowseForFolder Lib "shell32.dll" _
Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long
'Aufruf des Dialogs zur Ordnerauswahl

Function GetDirectory(Optional msg) As String
Dim bInfo As BROWSEINFO
Dim Path As String
Dim r As Long, x As Long, pos As Integer
bInfo.pidlRoot = 0&
If IsMissing(msg) Then
bInfo.lpszTitle = "Wählen Sie bitte einen Ordner aus."
Else
bInfo.lpszTitle = msg
End If
bInfo.ulFlags = &H1
x = SHBrowseForFolder(bInfo)
Path = Space$(512)
r = SHGetPathFromIDList(ByVal x, ByVal Path)
If r Then
pos = InStr(Path, Chr$(0))
GetDirectory = Left(Path, pos - 1)
Else
GetDirectory = ""
End If
End Function


' Hauptprozedur


Sub DirImport()
Application.ScreenUpdating = False
StrNewDir = GetDirectory("Wählen Sie bitte einen Ordner aus:")
If StrNewDir = "" Then Exit Sub
If Right(StrNewDir, 1) <> "\" Then
StrNewDir = StrNewDir & "\"
End If
Call DirChange(StrNewDir)
Application.ScreenUpdating = True
End Sub


'Rekursive Ermittlung aller Dateien des eingestellten Verzeichnisse

'inklusive aller Unterverzeichnisse


Function DirChange(Optional StrNewDir As String)
Dim rngCell As Range
Dim FileArray() As String, DirArray() As String
Dim strFileName As String, strExtLink As String
Dim intCounter As Integer, intDirNr As Integer
Dim intDirMax As Integer, intPos As Integer
'Bildschrimaktualisierung ausschalten
Application.ScreenUpdating = False
'Array für Unterverzeichnisse dimensionieren
intDirMax = 20: ReDim DirArray(intDirMax)
'1. Dateinamen einlesen
strFileName = Dir(StrNewDir, 0 + 1 + 2 + 4 + 16)
'Do-Loop-Schleife bis FileName = ""
Do While strFileName <> ""
If strFileName <> "." And strFileName <> ".." Then
'Aktuelle Datei in Statuszeile anzeigen
Application.StatusBar = StrNewDir & strFileName & " wird bearbeitet..."
If GetAttr(StrNewDir & strFileName) <> vbDirectory And _
Right(strFileName, 3) = "xls" Then
'Wenn kein Ordner vorliegt und die Datei die Endung "xls" aufweist,
'Pfad & Dateinamen (zur Kontrolle) in Spalte A eintragen.
ThisWorkbook.Worksheets("Tabelle1").Range("A" & Range("A65536") _
.End(xlUp).Row + 1) = StrNewDir & strFileName
'Anzeige der Statuszeile zurücksetzen.
Application.StatusBar = False
ElseIf GetAttr(StrNewDir & strFileName) = vbDirectory Then 'Verzeichnis
'Befindet sich in der Variablen ein Verzeichnisname, wird
'die Anzeige der Statuszeile zurückgesetzt,
Application.StatusBar = False
'der Verzeichnisname in das Verzeichnisarray eingelesen und
DirArray(intDirNr) = strFileName: intDirNr = intDirNr + 1
'wenn die Verzeichnisanzahl > der oben festgelegten Maximalanzahl
'ist, wird das Array neu dimensioniert.
If intDirNr > intDirMax Then
intDirMax = intDirMax + 20: ReDim Preserve DirArray(intDirMax)
End If
End If
End If
'Nächsten Dateinamen einlesen.
strFileName = Dir()
Loop
' Unterverzeichnisse rekursiv durcharbeiten
For intCounter = 0 To intDirNr - 1
DirChange (StrNewDir & DirArray(intCounter) & "\")
Next intCounter
'Bildschirmaktualisierung wieder einschalten.
Application.ScreenUpdating = True
End Function


aber ich möchte gerne nicht nur die Dateien "Eigene Dateien" und *.xls auslesen, sondern auch die anderen Verzeichnisse und andere Datei Endungen. Aber leider sind meine VBA Kenntnisse immer noch gleich null und wenn ich etwas ändere geht gar nix mehr. Ich hatte vor die "xls" endungen in * zu ändern und ich glaub auch das eingestellte Verzeichnis irgendwie, aber wie?

Kann mir jemand helfen, bitte?

PS:

Und vielleicht weiß auch jemand ein gutes Buch mit dem ich lernen kann. Ich brauch eins, in dem der Autor nicht davon ausgeht ich versteh blah blah sofort (und davon gibt es viele und hab auch schon so eins), sondern etwas das mich mit vielen Beispielen die ich selber nachvollziehen kann an die Materie ranführt.(?)