Přidat otázku mezi oblíbenéZasílat nové odpovědi e-mailemVyřešeno Script na hromadný přesun souborů a přejmenování

docela jsem to testoval, ale jistota je jistota, doporučuji před akcí mít zálohu ;-)

 Dim fso, f, file, path, warning, stary, novy, a, b, i, j
  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 a přesunuty 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")
  	For i = 1 to 37
		Set f = fso.GetFolder(path & "\" & i)
		fso.MoveFile f.path & "\mapa_run_" & i & ".png", f.path & "\mapa_run_" & i & "_1" & ".png"
		a = 1
		b = 3
		For j = 1 to 513
			stary = f.path & "\mapa_run_" & i & "_" & j & ".png"
			novy = f.path & "\" & i & "-" & ((j+8)\9) & "\" & a & b & ".png"
			fso.MoveFile  stary, novy
			b = b - 1
			
			if b = 0 then
				b = 3
				a = a + 1
				if a = 4 then
					a = 1
				end if
			end if
		next	
	next
end if

Podotýkám, že to je docela humpolácké, nechtělo se mi vymýšlet algoritmus na výpočet nového jména z pořadí (myslím, že by to šlo, jednu polovinu (pravou část bych věděl snad z fleku, ale nad zbytkem se mi nechtělo přemýšlet :-))

Reakce na odpověď

1 Zadajte svou přezdívku:
2 Napište svou odpověď:
3 Pokud chcete dostat ban, zadejte libovolný text:

Zpět do poradny