VBA for directory search and concatenating filenames

Question

I need to evolve the following code to do the concatenation of data in a certain way. I have a folder with photos of products, (several photos for each product) and I want Excel to do a search by the name of the photos and write the names of the photos for each product in a cell and separated by a comma.

Another issue is that for each product the photos may have different extensions ie may have JPG and/or PNG and/or JPEG. (see examples)

The name of the photos is the same as the reference of the product and if the product has more than one photo the name is differentiated by an alphabet letter at the end of the name and before the point and extension. Ex: ac2345to.jpg or 023198AAb.jpg or GDV7YDXc.jpeg The name can be just numbers, or just letters or a mix of numbers and letters.

Another condition is that to exist an ac2345 imageto.jpg there must be an ac2345.jpg image (or png or jpeg), for there to be a GDV7YDX imagec.jpeg there must be a GDV7YDX.jpg image (or png or jpeg), a GDV7YDX imageto.jpg(or png or jpeg) and a GDV7YDX imageb.jpg(or png or jpeg).

In total there can be 1000, 2000, 3000 photos or more in the folder and for each product there can be 1 or 2 or 3 or 15, etc. photos

Example

• Pictures of the product ac2345

  • ac2345.png
  • ac2345a.jpg
  • ac2345b.png

• PHOTOS OF THE PRODUCT 106

  • 106.jpeg
  • 106a.jpg
  • 106b.jpg
  • 106c.jpg
  • 106d.jpg

• Pictures of the product 023198AA

  • 023198AA.png
  • 023198AAa.png
  • 023198AAb.jpg

• Pictures of the product GDV7YDX

  • GDV7YDX.png
  • Gdv7ydxa.png
  • Gdv7ydxb.jpg
  • Gdv7ydxc.jpeg
  • Gdv7ydxd.jpg
  • Gdv7ydxe.png

Code

The code I show searches for all existing files in a folder and writes the filenames on a sheet but writes each name in a separate cell and all in column A.

Example:

Cellule A1 = ac2345.png

Cellula A2 = ac2345a.jpg

Cell A3 = ac2345b.png

Cell A4 = 106.jpeg

Cell A5 = 106a.jpg

Cell A6 = 106b.jpg

Cell A7 = 106c.jpg

Cell A8 = 106d.jpg

Cell A9 = 023198AA.png

Cell A10 = 023198Aa.png

Cell A11 = 023198AAb.jpg

Cell A12 = GDV7YDX.png

Cell A13 = Gdv7ydxa.png

Cell A14 = Gdv7ydxb.jpg

Cell A15 = Gdv7ydxc.jpeg

Cell A16 = Gdv7ydxd.jpg

Cell A17 = Gdv7ydxe.png

Problem

What I need is for the names for each product to be separated by comma in the same cell.

Example:

Cellule A1 = ac2345.png, ac2345a.jpg, ac2345b.png

Cell A2 = 106.jpeg, 106a.jpg, 106b.jpg, 106c.jpg, 106d.jpg

Cellula A3 = 023198AA.png, 023198Aa.png, 023198AAb.jpg

A4 cell = GDV7YDX.png, Gdv7ydxa.png, Gdv7ydxb.jpg, Gdv7ydxc.jpeg, Gdv7ydxd.jpg, Gdv7ydxe.png

Here’s the code I got:

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

Can anyone help me? I thank you all in advance.

Answer 1

You can refer to the Micrsoft Scripting Runtime library to make use of File System Object (FSO) objects, for example here. This way will work with all the files that are in the directory, from the loop of the result of the files, make the comparison with the product name, if it is, concatenate the result, only go to the next line if it is another product.

Answer 2

I made an example based on yours (without reference to the library I mentioned):

Sub GetJPGandPNGandJPEG()

Dim Path As String
Dim FileName As String
Dim LastDot As Long
Dim FileNameAux As String
Dim FileNameConc As String
Dim LastRow As Long

Path = "C:\Temp\Imagens\"
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 (FileNameAux = vbNullString) Then
      FileNameAux = Replace(FileName, LCase(Mid(FileName, LastDot)), "")
    End If

    If (InStr(1, FileName, FileNameAux, vbTextCompare)) Then
      If (FileNameConc = vbNullString) Then
      FileNameConc = FileName
    Else
      FileNameConc = FileNameConc & ", " & FileName
    End If
  Else
    If (FileNameConc = vbNullString) Then
      FileNameConc = FileName
    End If
    LastRow = Plan1.Cells(Plan1.Rows.Count, 1).End(xlUp).Row + 1
    Plan1.Cells(LastRow, 1) = FileNameConc
    FileNameAux = Replace(FileName, LCase(Mid(FileName, LastDot)), "")
    FileNameConc = FileName
  End If
End If
FileName = Dir
Loop
LastRow = Plan1.Cells(Plan1.Rows.Count, 1).End(xlUp).Row + 1
Plan1.Cells(LastRow, 1) = FileNameConc
End Sub

The result was so: