rename files in specific folder based on column value

tubrak

New Member
Joined
May 30, 2021
Messages
15
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

Do you hate GETPIVOTDATA?
Prevent GETPIVOTDATA. Select inside a PivotTable. In the Analyze tab of the ribbon, open the dropown next to Options and turn it off

ranman256

Well-known Member
Joined
Jun 17, 2014
Messages
1,991
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
 
Solution

tubrak

New Member
Joined
May 30, 2021
Messages
15
Office Version
  1. 2019
Platform
  1. Windows
thanks but it should delete all the string when replace the a new string in b4 just add to them the numbering 😕
 
Last edited:

tubrak

New Member
Joined
May 30, 2021
Messages
15
Office Version
  1. 2019
Platform
  1. Windows
thanks very much I found how deal the code ;)
 

Watch MrExcel Video

Forum statistics

Threads
1,133,530
Messages
5,659,355
Members
418,498
Latest member
nattynat

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
Top