Guru do Excel e Power BI

Galera , tudo bem? Seguinte estou com um VBA que estou usando para renomear alguns arquivos de um banco de dados.
O banco de dados esta da seguinte forma. Existe a pasta principal com varias subpastas e dentro destas subpastas ainda pode acontecer de ter outra pasta e consequentemente os arquivos que estou renomeando.

Eu queria uma ajuda para conseguir fazer com que o código conseguisse ler todos os arquivos direto, sem ter que ficar entrando em cada pasta e pegar apenas os arquivos em .jpg. Não sei se deu pra entender mas se alguém puder me ajudar segue o inicio do código.


Sub Renomearl()
Dim FName As String
'Cria um vetor de strings
Dim arNames() As String
Dim myCount As Integer
Dim fPasta As String
Dim lsExtensao As String

lsExtensao = "*.*"

'Seleciona a pasta
lsCaminho fPasta

'Determina o diretório e a extensão do arquivo
FName = Dir(fPasta & lsExtensao)

'Limpa a planilha
Plan1.Range("A9:A1048576").Clear

If [Tabela1].Rows.Count >= 2 Then
[Tabela1].Rows("2:" & [Tabela1].Rows.Count).Delete
End If

'Atribui o nome da pasta
Plan1.Range("F1").Value = fPasta

'Enquanto FName for igual a vazio "", realiza a listagem dos arquivos
Do Until FName = ""
myCount = myCount + 1
'Redimensiona o vetor, preservando os dados
ReDim Preserve arNames(1 To myCount)
arNames(myCount) = FName
'Passa os dados para a planilha
Cells(myCount + 8, 1).Value = arNames(myCount)
'Atualiza a variável FName
FName = Dir
Loop
End Sub

tem um jeito meio maluco, vc poderia fazer uma chamada no DOS para criar um txt com todos os arquivos seguindo seu criterio

dir *.jpg /s /B > resposta.txt

/s - procura sub diretorio
/B tira os headers, mostrando somente o nome dos arquivos

https://superuser.com/questions/1179829 ... t-suitable

ahi vc já vai ter a lista certinha no arquivo txt, é questao de vc abrir ele e pronto.

para rodar o comando do DOS no vba usa o comando Shell