I wrote this to rename files and folders (and optionally sub-folders) according to specified patterns. There are commercial versions but wanted one I could run from a web page. What I have to figure out now is better pattern matching.
<%
On Error Resume Next
Err.Clear
Response.Write "<html>" & vbNewLine & _
" <head>" & vbNewLine & _
" <title>Batch Renamer</title>" & vbNewLine & _
" </head>" & vbNewLine & _
" <body>" & vbNewLine
If Request("rename") = "doit" Then
strPath = Request("path")
strPattern = Request("pattern")
strChange = Request("change")
Subs = Request("subs")
Folds = Request("folds")
Const FSOForWriting = 2
Set objFSO = Server.CreateObject("Scripting.FileSystemObject")
If Not objFSO.FolderExists(strPath) Then
Response.Write "Folder: " & strPath & " does not exist. Create folder and set write permissions to include "<i>users</i>"."
Set objFSO = Nothing
my_Conn.Close
Set my_Conn = Nothing
Response.End
End If
With objFSO.GetFolder(strPath)
If .Attributes And ReadOnly Then
Response.Write "Folder: " & strPath & " cannot be written to. Set write permissions to include "<i>users</i>"."
Set objFSO = Nothing
my_Conn.Close
Set my_Conn = Nothing
Response.End
End If
End With
Set objFolder = objFSO.GetFolder(strPath)
If Not ((objFolder.Attributes And 2) Or (objFolder.Attributes And 4) Or (objFolder.Attributes And 32) Or (objFolder.Attributes And 64) Or (objFolder.Attributes And 2048)) Then
Set colFiles = objFolder.Files
intI = 0
For Each objItem In colFiles
Set objFile=objFSO.GetFile(objItem)
If (Not (objItem.Name="") Or isNull(objItem.Name) Or (objFile.Attributes And 2) Or (objFile.Attributes And 4) Or (objFile.Attributes And 32) Or (objFile.Attributes And 64) Or (objFile.Attributes And 2048)) Then
strFName = Replace(objItem.Name, "", "")
For i = 1 to Len(strFName)
If LCase(Mid(strFName,i, Len(strPattern))) = LCase(strPattern) Then
intMatch=1
Exit For
Else
intMatch=0
End If
Next
If intMatch=1 Then
intI = intI + 1
Response.write "Renamed " & strPath & "\" & strFName & " to " & strPath & "\" & Replace(objItem.Name, strPattern, strChange) & "<br />"
strTarget = strPath & "\" & Replace(strFName, strPattern, strChange)
strSource = strPath & "\" & strFName
objFSO.MoveFile strSource, strTarget
End If
Else
Response.write "Attributes issue on " & objItem.Name & "<br />"
End If
If Subs = 0 Then ShowSubFolders(objFolder)
Next
End If
Set objItem = Nothing
Set objFolder = Nothing
Set objFSO = Nothing
Response.write "Renamed " & intI & " files. Operation complete." & _
"<meta http-equiv=""Refresh"" content=""4;URL=renamer.asp"" />" & vbNewLine
Else
Response.write "<form action=""renamer.asp"" method=""post"">" & vbNewLine & _
" <input type=""hidden"" name=""rename"" value=""doit"" />" & vbNewLine & _
" <table align=""center"" width=""800"" border=""0"" cellpadding=""0"" cellspacing=""0"" bgcolor=""transparent"">" & vbNewLine & _
" <tr>" & vbNewLine & _
" <td align=""center"" width=""100%"" bgcolor=""navy"">" & vbNewLine & _
" <table align=""center"" width=""100%"" border=""1"" cellpadding=""4"" cellspacing=""0"">" & vbNewLine & _
" <tr>" & vbNewLine & _
" <td align=""center"" bgcolor=""lightskyblue"" width=""100%"" colspan=""2"">" & vbNewLine & _
" <font face=""arial unicode ms"" size=""12"" color=""navy""><b>Batch Renamer</b></font>" & vbNewLine & _
" </td>" & vbNewLine & _
" </tr>" & vbNewLine & _
" <tr bgcolor=""lightyellow"" valign=""top"">" & vbNewLine & _
" <td nowrap align=""right"" width=""20%"">" & vbNewLine & _
" <font face=""arial unicode ms"" size=""4"" color=""maroon""><b>Folder: </b> </font>" & vbNewLine & _
" </td>" & vbNewLine & _
" <td align=""center"" width=""80%"">" & vbNewLine & _
" <input type=""text"" name=""path"" style=""width:98%; text-align:center; maroon; font-weight:bold; background-color:cyan;"" value=""" & Request("path") & """ />" & vbNewLine & _
" </td>" & vbNewLine & _
" </tr>" & vbNewLine & _
" <tr bgcolor=""lightyellow"" valign=""top"">" & vbNewLine & _
" <td nowrap align=""right"" width=""20%"">" & vbNewLine & _
" <font face=""arial unicode ms"" size=""4"" color=""maroon""><b>Include What? </b></font>" & vbNewLine & _
" </td>" & vbNewLine & _
" <td align=""center"" width=""80%"">" & vbNewLine & _
" <font face=""arial unicode ms"" size=""4"" color=""maroon"">Root Only:<input type=""radio"" class=""radio"" name=""subs"" value=""1""" & chkRadio(subs,0,false) & "> Subfolders:<input type=""radio"" class=""radio"" name=""subs"" value=""0""" & chkRadio(subs,0,true) & "></font>" & vbNewLine & _
" </td>" & vbNewLine & _
" </tr>" & vbNewLine & _
" <tr bgcolor=""lightyellow"">" & vbNewLine & _
" <td nowrap align=""right"" width=""20%"">" & vbNewLine & _
" <font face=""arial unicode ms"" size=""4"" color=""maroon""><b>Pattern to Change: </b></font>" & vbNewLine & _
" </td>" & vbNewLine & _
" <td align=""center"" width=""80%"">" & vbNewLine & _
" <input type=""text"" name=""pattern"" style=""width:98%; text-align:center; maroon; font-weight:bold; background-color:cyan;"" value=""" & Request("pattern") & """ />" & vbNewLine & _
" </td>" & vbNewLine & _
" </tr>" & vbNewLine & _
" <tr bgcolor=""lightyellow"">" & vbNewLine & _
" <td nowrap align=""right"" width=""20%"">" & vbNewLine & _
" <font face=""arial unicode ms"" size=""4"" color=""maroon""><b>Change Pattern to: </b></font>" & vbNewLine & _
" </td>" & vbNewLine & _
" <td align=""center"" width=""80%"">" & vbNewLine & _
" <input type=""text"" name=""change"" style=""width:98%; text-align:center; maroon; font-weight:bold; background-color:cyan;"" value=""" & Request("change") & """ />" & vbNewLine & _
" </td>" & vbNewLine & _
" </tr>" & vbNewLine & _
" <tr bgcolor=""lightyellow"" valign=""top"">" & vbNewLine & _
" <td nowrap align=""right"" width=""20%"">" & vbNewLine & _
" <font face=""arial unicode ms"" size=""4"" color=""maroon""><b>Rename What?: </b></font>" & vbNewLine & _
" </td>" & vbNewLine & _
" <td align=""center"" width=""80%"">" & vbNewLine & _
" <font face=""arial unicode ms"" size=""4"" color=""maroon"">Folders and Files:<input type=""radio"" class=""radio"" name=""folds"" value=""1""" & chkRadio(folds,0,false) & "> Only Files:<input type=""radio"" class=""radio"" name=""folds"" value=""0""" & chkRadio(folds,0,true) & "></font>" & vbNewLine & _
" </td>" & vbNewLine & _
" </tr>" & vbNewLine & _
" </table>" & vbNewLine & _
" </td>" & vbNewLine & _
" </tr>" & vbNewLine & _
" <tr>" & vbNewLine & _
" <td align=""center"" width=""100%"" bgcolor=""transparent"">" & vbNewLine & _
" <input style=""color:" & strHeadFontColor & "; font-weight:bold; font-family:" & strDefaultFontFace & "; padding:3px 6px 3px 6px; border:1px solid " & strTableBorderColor & "; text-shadow:0px 1px 1px #000; font-weight:bold; text-decoration:none; border-radius:25px; -webkit-border-radius:25px; background:"&strHColor&";"" type=""Submit"" class=""button2"" name=""submit"" value=""Submit"" />" & vbNewLine & _
" </td>" & vbNewLine & _
" </tr>" & vbNewLine & _
" </table>" & vbNewLine & _
"</form>" & vbNewLine
End If
On Error GoTo 0
Sub ShowSubFolders(objFolder)
Set colFolders = objFolder.SubFolders
For Each objSubFolder in colFolders
strFolderName = objSubFolder.Path
If folds = 1 Then
For i = 1 to Len(objSubFolder.Name)
If LCase(Mid(objSubFolder.Name, i, Len(strPattern))) = LCase(strPattern) Then
intMatch = 1
Exit For
Else
intMatch = 0
End If
Next
End If
If intMatch = 1 Then
objSubFolder.Attributes = 0
With objFSO.GetFolder(strFolderName)
If .Attributes And ReadOnly Then
Response.Write "Folder: " & strFolderName & " cannot be renamed. Set write permissions to include "<i>users</i>"."
End If
End With
strTarget = Replace(strFolderName, strPattern, strChange)
strSource = strFolderName
Response.write "Renamed " & strSource & " to " & strTarget & "<br />"
objFSO.MoveFolder strSource, strTarget
End If
If Not ((objSubFolder.Attributes And 2) Or (objSubFolder.Attributes And 4) Or (objSubFolder.Attributes And 32) Or (objSubFolder.Attributes And 64) Or (objSubFolder.Attributes And 2048)) Then
Set colFiles = objSubFolder.Files
On Error Resume Next
For Each objItem in colFiles
Set objFile=objFSO.GetFile(objItem)
If (Not (objItem.Name="") Or isNull(objItem.Name) Or (objFile.Attributes And 2) Or (objFile.Attributes And 4) Or (objFile.Attributes And 32) Or (objFile.Attributes And 64) Or (objFile.Attributes And 2048)) Then
strFName = Replace(objItem.Name, "", "")
For i = 1 to Len(strFName)
If LCase(Mid(strFName,i, Len(strPattern))) = LCase(strPattern) Then
intMatch=1
Exit For
Else
intMatch=0
End If
Next
If intMatch=1 Then
intI = intI + 1
Response.write "Renamed " & strFolderName & "\" & strFName & " to " & strFolderName & "\" & Replace(strFName, strPattern, strChange) & "<br />"
strTarget = strFolderName & "\" & Replace(strFName, strPattern, strChange)
strSource = strFolderName & "\" & strFName
objFSO.MoveFile strSource, strTarget
End If
Else
Response.write "Attributes issue on " & objItem.Name & "<br />"
End If
Next
ShowSubFolders(objSubFolder)
End If
Set colFiles = Nothing
Next
End Sub
Function chkRadio(actualValue, thisValue, boltf)
If IsNumeric(actualValue) Then actualValue = cLng(actualValue)
If actualValue = thisValue EQV boltf Then
chkRadio = " checked"
Else
chkRadio = ""
End If
End Function
%>
ASP Batch Rename
Posted - 23 June 2015 : 02:24:12
