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)