Rename all files in a folder based on a cell value

[TheHack22]

Hi experts,

Can someone help me with a VBA Code that will loop through a predefined folder and rename all the files in a folder based on cell B2?
Will need to incorporate the CLEAN Function because of the spaces in cell B2.

I looked online for VBA scripts to do this task, but couldn't find one that serves my purpose. Any help would be greatly appreciated.

Imran

 

[ranman256]

here's a basic renaming app. It gets Source & target from the sheet, then renames all files in the vTargDir
alter it to fit your sheet:

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