rename files in specific folder based on column value

tubrak

Board Regular
Joined
May 30, 2021
Messages
216
Office Version
  1. 2019
Platform
  1. Windows
hi professional

I have many images in this directory "D:\FILES\images" the images names are different (IMAGE1-1000.JPG , IM_1000_23.PNG, IM_ASD.GIF , AAW100_78UY.JPG,1.PNG, 1000_IM.JPG) so as you see many extensions and different the name it contains digits and letters and symbols

so what I want rename all of files are existed in this directory based on COLUMN A the names also contain digits and letters and symbols

sometimes I put this name like this employee_100_as and sometimes IM/23we_1000 or 1000-df-em1 and so on
in short word the actual images contain digits and letters and symbols also the new names in COL A contains the same thing then it should rename the all files based on values into COLA
thanks in advance
 

Excel Facts

VLOOKUP to Left?
Use =VLOOKUP(A2,CHOOSE({1,2},$Z$1:$Z$99,$Y$1:$Y$99),2,False) to lookup Y values to left of Z values.
on the sheet label these cells:
B1 is the Folder to alter files
B3 is the string to search for in the filename
B4 is the string to replace it for the new filename

add a button to run macro: RenameAllFiles

Code:
Public Sub RenameAllFiles()
Dim fso, oFolder, oFile, oRX, vTargDir, vFindWord, vReplaceWord, vNewNameFull, vName
Dim sTxt As String, sFile As String
Dim vNewName
Const kiNUM = 2
'find & replace are CASE SENSITIVE
 
vTargDir = FixDir(Range("B1").Value)
vFindWord = LCase(Range("B3").Value)
vReplaceWord = Range("B4").Value
Set fso = CreateObject("Scripting.FileSystemObject")
Set oFolder = fso.GetFolder(vTargDir)
 
  'results of change
Range("A10:B200").Clear
Range("A10").Select
For Each oFile In oFolder.Files
  vName = LCase(oFile.Name)
  If InStr(vName, vFindWord) > 0 Then GoSub RenameIt
Next
Set oFile = Nothing
Set oFolder = Nothing
Set fso = Nothing
MsgBox "Done"
Exit Sub
RenameIt:
    vNewName = Replace(vName, vFindWord, vReplaceWord)
    vNewNameFull = vTargDir & vNewName
    Name oFile As vNewNameFull
    ActiveCell.Value = vNewName
    ActiveCell.Offset(1, 0).Select  'next row
Return
End Sub

Private Function FixDir(pvPath)
If pvPath = "" Then Exit Function
If Right(pvPath, 1) <> "\" Then pvPath = pvPath & "\"
FixDir = pvPath
End Function
 
Upvote 0
Solution
thanks but it should delete all the string when replace the a new string in b4 just add to them the numbering ?
 
Last edited:
Upvote 0

Forum statistics

Threads
1,213,529
Messages
6,114,155
Members
448,554
Latest member
Gleisner2

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