VBA para pesquisa de pastas e concatenar nomes de ficheiros

[xicosantos]

Ola pessoal, preciso da vossa ajuda por favor.

Preciso de evoluir o seguinte codigo para fazer a concatenação de dados de certa forma.
Tenho uma pasta com fotos de produtos, (varias fotos para cada produto) e pretendo que o excel faça uma busca pelo nome das fotos e escreva os nomes das fotos referentes a cada produto numa celula e separados por virgula.
O nome das fotos é o mesmo que a referencia do produto e caso o produto tenha mais de uma foto o nome é diferenciado por uma letra do alfabeto no fim do nome antes do ponto e da extenção.
Outra questão é que para cada produto as fotos podem ter diferentes extensões ou seja, pode ter JPG e/ou PNG e/ou JPEG.
No total podem existir 1000, 2000, 3000 fotos ou mais na pasta e para cada produto podem existir 1 ou 2 ou 3 ou 15, etc. fotos

Vamos aos exemplos:

FOTOS do produto ac2345
ac2345.png
ac2345a.jpg
ac2345b.png

FOTOS do produto 106
106.jpeg
106a.jpg
106b.jpg
106c.jpg
106d.jpg

FOTOS do produto 023198AA
023198AA.png
023198AAa.png
023198AAb.jpg

ETC.

O codigo que apresento faz a busca de todos os ficheiros existentes em uma pasta e escreve os nomes dos ficheiros numa planilha mas escreve cada nome numa celula em separado e todos na coluna A.

Exemplo:
ac2345.png
ac2345a.jpg
ac2345b.png
106.jpeg
106a.jpg
106b.jpg
106c.jpg
106d.jpg
023198AA.png
023198AAa.png
023198AAb.jpg

ETC.

O que eu preciso é que na mesma celula fiquem os nomes referentes a cada produto separados por virgula.
Exemplo:

Celula A1 = ac2345.png, ac2345a.jpg, ac2345b.png
Celula A2 = 106.jpeg, 106a.jpg, 106b.jpg, 106c.jpg, 106d.jpg
Celula A3 = 023198AA.png, 023198AAa.png, 023198AAb.jpg

Eis o codigo que tenho:

------------------------------------------------------------------------------------------------------------------------------------------------
Sub GetJPGandPNGandJPEG()
Dim X As Long, LastDot As Long, Path As String, FileName As String, F(0 To 9) As String
Path = "C:\teste\"
FileName = Dir(Path & "*.*p*g")
Do While Len(FileName)
LastDot = InStrRev(FileName, ".")
If LCase(Mid(FileName, LastDot)) = ".jpg" Or LCase(Mid(FileName, LastDot)) = ".png" Or LCase(Mid(FileName, LastDot)) = ".jpeg" Then
If Left(FileName, 1) Like "#" Then
F(Left(FileName, 1)) = F(Left(FileName, 1)) & ", " & FileName
End If
End If
FileName = Dir
Loop
For X = 0 To 9
Cells(X + 1, "A").Value = Mid(F(X), 3)
Next
Range("A1:A10").SpecialCells(xlBlanks).Delete
End Sub
--------------------------------------------------------------------------------------------------------------------------------------------------------
Será que alguém me pode ajudar? Agradeço desde já a todos.
Obrigado

[osvaldomp]

Olá, xicosantos
Comentários:

1. o seu código relaciona os arquivos que têm uma das extensões mencionadas desde que o nome do arquivo se inicie por um algarismo. Então os arquivos que você menciona: ac2345.png, ac2345a.jpg, ac2345b.png, não serão relacionados pois seus nomes não se inicaim por algarismo e sim por letra.

2. o seu código faz o agrupamento dos nomes com base na igualdade do primeiro algarismo do nome, assim, são feitos os agrupamentos seguintes:

Celula Ax = 106.jpeg, 106a.jpg, 106b.jpg, 106c.jpg, 106d.jpg >> neste grupo todos os nomes iniciam com o algarismo 1
Celula Ay = 023198AA.png, 023198AAa.png, 023198AAb.jpg >> neste grupo todos os nomes iniciam com o algarismo 0
.

Com base nesse critério de agrupar pela igualdade do primeiro algarismo, o código faria um grupo com os seguintes nomes: 7jacaré, 7_macaco, 7 sapo >> todos iniciam pelo algarismo 7
Já, os arquivo com os nomes jacaré, macaco e sapo não seriam relacionadps pois iniciam por uma letra e não por um algarismo

Faça os testes e retorne para dizer o que precisa.