Rename files by finding and replacing text within the filename. Edit settings to change whether text replace is case sensitive and how many times to replace the text.

Set objFSO = CreateObject("Scripting.FileSystemObject")

Set objShell = CreateObject ("Shell.Application")
Set objTFolder = objShell.BrowseForFolder (0, "Select Target Folder", (0))
targetPath = objTFolder.Items.Item.Path

'Max number of times to replace string
strCount = 999
'Comparison type: 0 = case sensitive, 1 = case insensitive
strCompare = 1

If targetPath = "" Then
Wscript.Quit
End If

strFind = InputBox("Add string to find.","String to Find", "")

If strFind = "" Then
Wscript.Quit
End If

strReplace = InputBox("Add string to replace with.","Replace with", "")

Set objFolder = objFSO.GetFolder(targetPath)

fileRename objFolder

Sub fileRename(folder)

  'Loop through the files in the folder
  For Each objFile In folder.Files

filename = objFile.Name
ext = objFSO.getExtensionName(objFile)
safename = Left(filename, Len(filename) - Len(ext) - 1)

strStart = 1
safename = Replace(safename, strFind,strReplace,strStart,strCount,strCompare)

safename = trim(safename)

On Error Resume Next

'Only rename if new name is different to original name
If filename <> safename & "." & ext Then

'Uncomment the line below to prompt before each rename
Wscript.Echo "Renaming "  & vbCRLF & objFile.Name & " to " & vbCRLF & safename & "." & ext

objFSO.MoveFile objFile.Path, objFile.ParentFolder.Path & "\" & safename & "." & ext
End If

If Err.Number <> 0 Then
WScript.Echo "Error renaming: " & filename.path & "Error: " & Err.Description
Err.Clear
End If

Next

'Uncomment lines below to act on files in all subfolders
'For Each Subfolder In folder.SubFolders
'fileRename Subfolder
'Next

End Sub

Wscript.echo "Done"