Tak tady to je:

 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 & "\" & 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

ulož si to jako "něco.vbs" a doporučuju spouštět pomocí příkazu cscript něco.vbs v konzoli CMD.

Chyby které jsem neodladil: Čas od času se mi stane, že první přejmenování (pro mě nepochopitelně) vezme při volání metody sfl.Files (tj. při načítání jmen souborů) i sobory, které "teprve budou" - jak kdyby během vnitřní smyčkou ještě jednou aktualizoval -> z toho plyne, že se může stát, že číslování nepůjde od 0001, ale od vyššího čísla. Nicméně druhé spuštění skriptu proběhne už ok. Jsem zmaten, vysvětlí mi to někdo? (Přece jen nejsem VBS guru ) Ještě mě napadá přepsat to pomocí WMI, ale to se mi už nechce

Možné úpravy: Pokud se z obou cyklů vyhážou všechny Wscript.echo výpisy do konzoly, je možné pohodlně spouštět skript pomocí wscript (tj. poklikáním na ikonku), ale pak není žádný záznam o činnosti skriptu. Dále je možno změnit počet nul v číslování - postačí změnit poslední číslovku ve funci Right("0000" & CStr(counter),4) na požadovanou hodnotu (nyní jsou 4)