Stephen’s Personal Blog

dim szRootfolder
szRootFolder = "E:\Documents and Settings\Stephen\My Documents\copy of new"

dim lNumFiles, lNumFilesRenames, lNumFolders
lNumFiles = 0
lNumFilesRenames = 0
lNumFolders = 0

dim fso
set fso = CreateObject("Scripting.FileSystemObject")

NextFolder szRootFolder
WScript.Echo lNumFilesRenames & " of " & lNumFiles & " Renamed in " & lNumFolders & " Folders"

function NextFolder(szFolderPath)
dim fld, subfld, fil
dim lUniqueID, szFolderName, szFileName
dim lNumLocalFiles, lNumLocalFilesRenames
lNumLocalFiles = 0
lNumLocalFilesRenames = 0
dim Ar, szExt
set fld = fso.GetFolder(szFolderPath)
lUniqueID = GetLastNumber(szFolderPath)
szFolderName = fld.Name
lNumFolders = lNumFolders + 1
for each fil in fld.Files
Ar = Split(fil.Name, ".")
szFileName = Ar(0) 'filename.ext
if UBound(Ar, 1) > 0 then szExt = Ar(1) else szExt = ""
if szExt = "tif" or szExt = "gif" or szExt = "jpg" or szExt = "bmp" or szExt = "png" then
if not IsFormatted(szFileName, szFolderName) then
lUniqueID = lUniqueID + 1
szFileName = szFolderName & CStr(lUniqueID)
if Len(szExt) > 0 then
fil.Name = szFileName & "." & szExt ' rename the file
else
fil.Name = szFileName ' rename the file
end if
lNumFilesRenames = lNumFilesRenames + 1
lNumLocalFilesRenames = lNumLocalFilesRenames + 1
end if
lNumFiles = lNumFiles + 1
lNumLocalFiles = lNumLocalFiles + 1
end if
next
WScript.Echo lNumLocalFilesRenames & " of " & lNumLocalFiles & " Renamed"

for each subfld in fld.SubFolders
WScript.Echo szFolderPath & "\" & subfld.Name
NextFolder = NextFolder(szFolderPath & "\" & subfld.Name)
next
end function 'NextFolder

function GetLastNumber(szFolderPath)
dim fld, fil, szFolderName, lFolderNameLen
dim szFileName, lLastNumber, lNextNumber
dim Ar
lNextNumber = 0
set fld = fso.GetFolder(szFolderPath)
szFolderName = fld.Name
lFolderNameLen = Len(szFolderName)
for each fil in fld.Files
Ar = Split(fil.Name, ".")
szFileName = Ar(0) 'filename.ext
if Len(szFileName) > lFolderNameLen then
if szFolderName = Left(szFileName, lFolderNameLen) then
'Folder Name root matches, get number
lNextNumber = GetNumber(szFileName, lFolderNameLen)
if lLastNumber < lNextNumber then lLastNumber = lNextNumber
end if
end if
next

GetLastNumber = lLastNumber
end function 'GetLastNumber

function IsFormatted(szFileName, szFolderName)
dim lFolderNameLen, bReturn
bReturn = false

lFolderNameLen = Len(szFolderName)
if Len(szFileName) > lFolderNameLen then
if szFolderName = Left(szFileName, lFolderNameLen) then
bReturn = true
end if
end if

IsFormatted = bReturn
end function 'IsFormatted