Snitz Forums 2000
Snitz Forums 2000
Home | Profile | Register | Active Topics | Members | Search | FAQ
 All Forums
 Community Forums
 Code Support: ASP (Non-Forum Related)
 ASP Batch Rename

Note: You must be registered in order to post a reply.
To register, click here. Registration is FREE!
Before posting, make sure you have read this topic!

Screensize:
UserName:
Password:
Format Mode:
Format: BoldItalicizedUnderlineStrikethrough Align LeftCenteredAlign Right Horizontal Rule Insert HyperlinkInsert EmailInsert Image Insert CodeInsert QuoteInsert List
   
Message:

* HTML is OFF
* Forum Code is ON
Smilies
Smile [:)] Big Smile [:D] Cool [8D] Blush [:I]
Tongue [:P] Evil [):] Wink [;)] Clown [:o)]
Black Eye [B)] Eight Ball [8] Frown [:(] Shy [8)]
Shocked [:0] Angry [:(!] Dead [xx(] Sleepy [|)]
Kisses [:X] Approve [^] Disapprove [V] Question [?]

 
   

T O P I C    R E V I E W
Carefree Posted - 23 June 2015 : 02:24:12
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
%>

Snitz Forums 2000 © 2000-2021 Snitz™ Communications Go To Top Of Page
This page was generated in 0.04 seconds. Powered By: Snitz Forums 2000 Version 3.4.07