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
