'Here's a sample VBS file that will do the trick:
Sub Main()
Dim objFSO, objDest, objOrig, objFile
Set objFSO = CreateObject("Scripting.FileSystemObject")
'--- Get the origin and destination paths and verify their validity ---
Dim strOrig, strDest, strPrefix, bValidDest, bValidOrig
bValidDest = False
bValidOrig = Flse
Do until bValidOrig
strOrig = InputBox("Enter the path to the folder that the files you would like to move are located:", "Incremental File Mover/Namer")
If Trim(strOrig & "") = "" then
Exit Sub
Else
bValidOrig = objFSO.FolderExists(strOrig)
If not bValidOrig Then
msgbox("Invalid folder!")
End If
End If
Loop
Do Until bValidDest
strDest = InputBox("Enter the path to which you would like to move the files:", "Incremental File Mover/Namer")
If Trim(strDest & "") = "" then
Exit Sub
Else
bValidDest = objFSO.FolderExists(strDest)
If not bValidDest Then
msgbox("Invalid folder!")
End If
End If
Loop
strPrefix = InputBox("Enter the prefix you would like to append to the filenames [optional]:", "Incremental File Mover/Namer")
Set objDest = objFSO.GetFolder(strDest)
Set objOrig = objFSO.GetFolder(strOrig)
'--- Analyze the files in the destination folder to determine the next increment ---
Dim iVal, strTemp
iVal = 0
on error resume next 'ignore errors that could be generated by a mal-formed filename.
For Each objFile in objDest.Files
strTemp = Trim(Mid(objFile.Name, InStr(objFile.name, " "), (Len(objFile.Name) - (InStr(objFile.Name, " ") + (Len(objFile.Name) - InStrRev(objFile.Name, "."))))) & "")
if IsNumeric(strTemp) then
If CDbl(strTemp) > iVal Then
iVal = CDbl(strTemp) + 1
End If
End if
Next
on error goto 0 'turn error checking back on.
'--- Rename and move each file accordingly ---
For Each objFile in objOrig.Files
objFile.Copy(objDest.Path & "\" & strPrefix & " " & iVal & "." & Right(objFile.Name, Len(objFile.name) - InStrRev(objFile.Name, ".")))
objFile.Delete()
iVal = iVal + 1
Next
MsgBox("Finished.")
End Sub
Call Main()
Facebook
Twitter