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