Soft na hromadné přejmenování souborů v adresáři podle názvu adresáře?

Chyba byla odhalena Nechtěně jsem nedodal v jedné části odpovídající property, teď už by to mělo být ok.

 Dim fso, f, sf, sfl, folder, file, filelist, counter, warning, stary, novy
  path = InputBox("Zadejte cestu k nadřazenému adresáři ve kterém se nachází adresáře s obrázky")
  warning = MsgBox("Budou přejmenovány soubory v podadresářích tohoto adresáře: " & path & ". Je to správně?", 276, "Poslední záchrana") 
  if warning = 6 then
  	Set fso = CreateObject("Scripting.FileSystemObject")
  	Set f = fso.GetFolder(path)
  	Set sf = f.SubFolders
  	For Each folder in sf
		counter = 1
		Set sfl = fso.GetFolder(folder)
		set filelist = sfl.Files
		Wscript.echo " "
		Wscript.echo "Adresář " & folder
		Wscript.echo "číslo - starý název - nový název"
		Wscript.echo "==============================================================================="
		For Each file in filelist
			stary = file
			novy = folder.path & "\" & folder.Name & Right("0000" & CStr(counter),4) & "." & Right(stary,3)
			fso.MoveFile stary, novy
			wscript.echo counter & " - " & stary & " - " & novy
			counter = counter + 1
		next

	  next
 	Wscript.echo "Akce provedena!"
  Else
  	Wscript.echo "Akce byla zrušena!"
 	
  end if

Taky děkuju, ten script jsem rovněž využil. Jen, možná kvůli většímu počtu přejmenovaných .jpg, se přípona asi u 200 z 1100 .jpg změnila v .peg. Při dalším pokusu o přejmenování stejné sady fotek se počet chybných snížil asi na 50. Taky .peg. Je to zvláštní a mám hledat chybu v hardware, že tu operaci nestíhal, nebo je to normální a je to tím velkým množstvím?
CPU 2.26 GHz, RAM 512 MB. Docela mě to zajímá, ale k netu se dostanu až odpoledne, tak sorry, že třeba hned nebudu reagovat.

nedalo mi to a upravil/opravil jsem to

Dim fso, f, sf, sfl, folder, file, filelist, counter, warning, stary, novy, koncovka
  path = InputBox("Zadejte cestu k nadřazenému adresáři ve kterém se nachází adresáře s obrázky")
  warning = MsgBox("Budou přejmenovány soubory v podadresářích tohoto adresáře: " & path & ". Je to správně?", 276, "Poslední záchrana") 
  if warning = 6 then
  	Set fso = CreateObject("Scripting.FileSystemObject")
  	Set f = fso.GetFolder(path)
  	Set sf = f.SubFolders
  	For Each folder in sf
		counter = 1
		Set sfl = fso.GetFolder(folder)
		set filelist = sfl.Files
		Wscript.echo " "
		Wscript.echo "Adresář " & folder
		Wscript.echo "číslo - starý název - nový název"
		Wscript.echo "==============================================================================="
		For Each file in filelist
			stary = file
			koncovka = Split(file.name, ".", -1, 1)
			novy = folder.path & "\" & folder.Name & Right("0000" & CStr(counter),4) & "." & koncovka(UBound(koncovka))
			fso.MoveFile stary, novy
			wscript.echo counter & " - " & stary & " - " & novy
			counter = counter + 1
		next

	  next
 	Wscript.echo "Akce provedena!"
  Else
  	Wscript.echo "Akce byla zrušena!"
 	
  end if

Díky, hluboká poklona tvým znalostem a ochotě.

ook-eek!

Ha!To delal Polda ze Ctyrlistku!

super diky, i po nekolika letech byl pro me problem sehnat neco co zvladne takovouhle primitivni ulohu. total commander to neumi a zkousel jsem dalsi 3 renamery nez jsem narazil na tohle reseni. dik

Do TC stačí doinstaloval FileX a v hromadném přejmenování je to potom pod tlačítkem [=?] filex - ParentDir.