Abrir ficheros excel de supcarpetas

Hola a todos, soy nueva por aquí! He creado una macro que abre todos los ficheros excel de una carpeta y los protege poniendo una clave en cada una de sus hojas. Mi problema es que necesito que esto sea recursivo, es decir, que además de abrir la carpeta principal y encriptar sus excels, abra todas las subcarpetas y haga lo mismo para todos los archivos .xls. Creo que tengo que listar todas las subcarpetas que existen y luego abrirlas o algo así, pero esta segunda parte no sé cómo hacerla. Los códigos que tengo son los siguientes:

Abrir una carpeta y encriptar sus archivos excel:

Sub encriptar()
'declarar las variables que usemos
Dim MiRuta
As String
Dim arcact As String
If Range("G4").Value = 0
Then ' Si no se ha introducido dato de ruta en la celda NO CONTINUA
MsgBox ("ERROR!!! FALTA RUTA DIRECTORIOS")
Exit Sub
End If
MiRuta =
ActiveWorkbook.Path
arcact = ActiveWorkbook.Name
Dim arch As
String
MiRuta = Range("G4").Value
arch = Dir(MiRuta &
"\*.xls")
Do Until arch = ""
If arch = arcact Then GoTo Salto
Workbooks.Open
Filename:=MiRuta & "\" & arch
For Each sht In
ActiveWorkbook.Sheets
sht.Protect Password:="test"
Next sht
'For Each sht In OpenWorkbook.Sheets ' le pongo la
contraseña a todas las hojas
' sht.Protect Password:="maite"
'Next sht
ActiveWorkbook.Sabe
ActiveWorkbook.Close
Salto:
arch
= Dir
Loop
End Sub

 Listar todas las subcarpetas de una carpeta:

Sub Ck()
Dim strStartPath As String
strStartPath = "C:\" 'ENTER YOUR START FOLDER HERE
ListFolder strStartPath
End Sub
Sub ListFolder(sFolderPath As String)
Dim FS As New FileSystemObject
Dim FSfolder As Folder
Dim subfolder As Folder
Dim i As Integer
Set FSfolder = FS.GetFolder(sFolderPath)
For Each subfolder In FSfolder.SubFolders
DoEvents
i = i + 1
'added this line
Cells(i, 1) = subfolder
'commented out this one
'Debug.Print subfolder
Next subfolder
Set FSfolder = Nothing
'optional, I suppose
MsgBox "Total sub folders in " & sFolderPath & " : " & i
End Sub

El problema es que no sé fusionarlos ni hacer que abra los excels de las subcarpetas...

MUCHAS GRACIAS POR VUESTRO TIEMPO!!