VBA code and data concatenation

xicosantos

New Member
Joined
Feb 5, 2015
Messages
12
Hello I wonder that someone can help me?
I have a folder with several photos (jpg and png) whose names are numbers and letters


eg
12345.jpg
12345a.jpg
12345b.jpg
12345c.png
9876.png
9876a.png
9876b.jpg etc.


and I was wondering how to make an application in vba to list all the photos names in that folder and then put in the same cell the names whose initial digits are the same and separated by a comma.
eg


Cell 1 = 12345.jpg, 12345a.jpg, 12345b.jpg, 12345c.png
Cell 2 = 9876.png, 9876a.png, 9876b.jpg
Etc.


Is it possible to do?
Someone can help me? Thanks in advanced
 

Excel Facts

Quick Sum
Select a range of cells. The total appears in bottom right of Excel screen. Right-click total to add Max, Min, Count, Average.
I have this code to retrieve the files names but it writes on a new sheet and in multi rows - one column.


-------------------------------------------------------------------
Sub Retrieve_File_listing()
Worksheets(1).Cells(2, 1).Activate
Call Enlist_Directories("C:\test ", 1)
End Sub
Public Sub Enlist_Directories(strPath As String, lngSheet As Long)
Dim strFldrList() As String
Dim lngArrayMax, x As Long
lngArrayMax = 0
strFn = Dir(strPath & "*.*", 23)
While strFn <> ""
If strFn <> "." And strFn <> ".." Then
If (GetAttr(strPath & strFn) And vbDirectory) = vbDirectory Then
lngArrayMax = lngArrayMax + 1
ReDim Preserve strFldrList(lngArrayMax)
strFldrList(lngArrayMax) = strPath & strFn & "\"
Else
ActiveCell.Value = strPath & strFn
Worksheets(lngSheet).Cells(ActiveCell.row + 1, 1).Activate
End If
End If
strFn = Dir()
Wend
If lngArrayMax <> 0 Then
For x = 1 To lngArrayMax
Call Enlist_Directories(strFldrList(x), lngSheet)
Next
End If
End Sub

--------------------------------------------------------------

Thats not what i need.. But its a begining. :) I tried diferent aproachs but none work.. I really need the answer to this problem.. Thanks
 
Upvote 0
Give this macro a try (change the Path assignment to the path where your files are located)...
Code:
Sub GetJPGandPNG()
  Dim X As Long, LastDot As Long, Path As String, FileName As String, F(0 To 9) As String
  Path = "[B][COLOR="#FF0000"]c:\temp\test\[/COLOR][/B]"  [B][COLOR="#008000"]'Note the trailing slash[/COLOR][/B]
  FileName = Dir(Path & "*.*p*g")
  Do While Len(FileName)
    LastDot = InStrRev(FileName, ".")
    If LCase(Mid(FileName, LastDot)) = ".jpg" Or LCase(Mid(FileName, LastDot)) = ".png" 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
 
Upvote 0
Give this macro a try (change the Path assignment to the path where your files are located)...
Code:
Sub GetJPGandPNG()
  Dim X As Long, LastDot As Long, Path As String, FileName As String, F(0 To 9) As String
  Path = "[B][COLOR=#FF0000]c:\temp\test\[/COLOR][/B]"  [B][COLOR=#008000]'Note the trailing slash[/COLOR][/B]
  FileName = Dir(Path & "*.*p*g")
  Do While Len(FileName)
    LastDot = InStrRev(FileName, ".")
    If LCase(Mid(FileName, LastDot)) = ".jpg" Or LCase(Mid(FileName, LastDot)) = ".png" 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



Hello Rick, I appreciate your response and your code is much closer of what I need, but I gave a bad explanation of what i need at the beginning of the post.
In that folder I can have 10 photos or 100 or 1000 or more. In this case I have over 3000. Your code works perfectly and once again I thank you, but he joins in the same cell all the names that begin with 1, then joins in another cell all names starting with 2 and another all starting with 3 etc.
But what I need is that the code adds the names in the same cell with the same numbers but that differ only letters or extension that is:
10331.jpg and 10331a.jpg and 10331b.png are photos of the same subject and they shall be together in a cell but the photos 10332.png and 10332a.jpg and 10332b.jpg and 10332c.png, they refer to another matter and should be together in another cell and photos 10445.png and 10445a.jpg and 10445.png, they should be in another cell. I hope my explanation is not too confusing.
Again Rick I thank you for taking your time answering my question.
 
Upvote 0
I forgot to mention the names of the files may have a digit or two or three or more (eg, 1.jpg, or 32.jpg, or 631.jpg, or 9876.jpg). I hope I'm not being really picky. Thanks again for your time
 
Upvote 0
I forgot to mention the names of the files may have a digit or two or three or more (eg, 1.jpg, or 32.jpg, or 631.jpg, or 9876.jpg). I hope I'm not being really picky. Thanks again for your time

Will any of the filenames ever start with a zero?
 
Upvote 0
Occasionally .. it can also start with a letter or two ... basically we are talking about photos of products which are related to the product sku. And each product can have several photos hence the sku product in the name (eg, sku=67514 <> foto name=67514 ) and then the letter before the extension for each additional image of this product (eg 67514a.jpg, 67514b.jpg, etc.). But if it is more complicated to start with zeros we can change that.
Thank you so much.
 
Upvote 0
Occasionally .. it can also start with a letter or two ... basically we are talking about photos of products which are related to the product sku. And each product can have several photos hence the sku product in the name (eg, sku=67514 <> foto name=67514 ) and then the letter before the extension for each additional image of this product (eg 67514a.jpg, 67514b.jpg, etc.). But if it is more complicated to start with zeros we can change that.
No, you don't have to change the leading zeroes as those leading letters pretty much causes the same problem for the approach I wanted to use as a leading zero does. Let me think a bit on a new approach to the problem.

Two questions...

1) If the name starts with a letter, multiple instances of that name are still indicated by letters (a, b, c, etc.) after the number part, correct?

2) The letters you affix after the number to indicate multiples of the same name... will that always be a single letter (never two or more letters)?
 
Upvote 0
This all exactly right, all instances of the same product will never have two letters as only have a maximum of 10 photos (10 instances) so will never be necessary to use more than one letter and will always be before the dot and extension, even if the sku is all letters will be something like:
GHJNMT.jpg, GHJNMTa.jpg, GHJNMTb.jpg, GHJNMTc.jpg
Thank you
 
Upvote 0
This all exactly right, all instances of the same product will never have two letters as only have a maximum of 10 photos (10 instances) so will never be necessary to use more than one letter and will always be before the dot and extension, even if the sku is all letters will be something like:
GHJNMT.jpg, GHJNMTa.jpg, GHJNMTb.jpg, GHJNMTc.jpg
Can the sku ever be all letters? If so, will those letters, except for the "instance letter", always be all upper case and will the "instance letter", when there is one, always be lower case?
 
Upvote 0

Forum statistics

Threads
1,223,230
Messages
6,170,883
Members
452,364
Latest member
springate

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top