Unterordner durchsuchen Excel VBA

Hi, ich habe mir ein Makro gebastelt, mit dem ich Daten aus mehreren Word Tabellen auslesen kann. Das Makro durchsucht alle Word Dokumente in einem Ordner, es sollte aber möglichst auch alle Unterordner in diesem Ordner durchsuchen. Zudem würde ich gerne Dokumente mit der Endung .docx UND .docm durchsuchen. Ist das möglich?

Hier mein Code:

Sub WordtabelleEinlesen()
Dim sPfad As String
Dim appWord As Object
Dim fd As FileDialog
Dim arrDaten
Dim zeichnung
Dim material
Dim bezeichnung
Dim cam
Dim vorrichtung1
Dim vorrichtung2
Dim vorrichtung3
Dim vorrichtung4
Dim strDatei As String
Dim loLetzte As Long
sPfad = "O:\ODE\Data\Produktion ODP\AVOR\allgemein\Laserprogramme - Überarbeitung\Test Makro Word Einrichtblätter Schüler\Original\" '<== Pfad anpassen  
Application.ScreenUpdating = False
Set appWord = CreateObject("Word.Application")  
appWord.Visible = True
strDatei = Dir(sPfad & "*.docx") '<== Dateiendung anpassen  
Do While strDatei <> ""  
appWord.Documents.Open sPfad & strDatei, , True 'fragt nich immer nach, ob dokument schreibgeschützt geöffnet werden soll  
If appWord.activeDocument.Tables.Count > 1 Then ' <== Abfrage ob mindestens 2 Tabellen enthalten sind  
tabelle = appWord.activeDocument.Tables(1).Cell(1, 3)
zeichnung = appWord.activeDocument.Tables(1).Cell(2, 3)
material = appWord.activeDocument.Tables(1).Cell(3, 3)
bezeichnung = appWord.activeDocument.Tables(1).Cell(4, 3)
cam = appWord.activeDocument.Tables(1).Cell(5, 3)
vorrichtung1 = appWord.activeDocument.Tables(1).Cell(10, 2)
vorrichtung2 = appWord.activeDocument.Tables(1).Cell(11, 2)
vorrichtung3 = appWord.activeDocument.Tables(1).Cell(12, 2)
vorrichtung4 = appWord.activeDocument.Tables(1).Cell(13, 2)
arrDaten = Split(Application.Substitute(appWord.activeDocument.Tables(1), Chr(7), ""), Chr(13) & Chr(13))  
With ThisWorkbook.Worksheets("Tabelle1").Columns(1)  
loLetzte = IIf(IsEmpty(.Cells(.Rows.Count, 1)), .Cells(.Rows.Count, 1).End(xlUp).Row, .Rows.Count) + 1
strInhalt = Mid(arrDaten(1), InStr(arrDaten(1), Chr(13)) + 1)
'strInhalt = Mid(strInhalt, 1, InStr(strInhalt, Chr(13)) - 1)  
.Cells(loLetzte, 1) = tabelle
.Cells(loLetzte, 2) = zeichnung
.Cells(loLetzte, 3) = material
.Cells(loLetzte, 4) = bezeichnung
.Cells(loLetzte, 5) = cam
.Cells(loLetzte, 6) = vorrichtung1
.Cells(loLetzte, 7) = vorrichtung2
.Cells(loLetzte, 8) = vorrichtung3
.Cells(loLetzte, 9) = vorrichtung4
Columns("A:I").AutoFit  
End With
End If
appWord.activeDocument.Close savechanges:=False
strDatei = Dir
Loop
appWord.Quit
Set appWord = Nothing
Set fd = Nothing
End Sub