Řazení souborů ve složce

Software potřebné k práci s elektronikou

Moderátor: Moderátoři

Zpráva
Autor
Uživatelský avatar
martinkopp
Příspěvky: 1303
Registrován: 12 říj 2023, 00:00

#16 Příspěvek od martinkopp »

Tady máš drobný vbscript který ti přejmenuje všechny mp3 ve složce ve které se nachází na něco0001... v pořadí ve kterém jsi je tam nakopíroval, přičemž "něco" si zadáš v objevivším se dialogovém okně. Ve složce následně vytvoří textový soubor se seznamem souboru. Kod ulož do textového souboru s názvem něco.vbs a spust poklikáním. Testováno ve w10 64b

Jen malé upozornění na závěr, soubory do složky musíš kopírovat, ne přesouvat. Při kopírování se změní "datum vytvoření", při přesunu nemá jak win poznat kdy byl přesunut. Takže zkopírovat a smáznout původní. "datum" který se zobrazuje v průzkumníku win zůstane nezměněn.

Kód: Vybrat vše

Option Explicit
Dim objFSO,objFolder,objFile
Dim strFolderPath,strBaseName,strNewFileName
Dim colFiles,arrFiles()
Dim i,j,strFileList
Dim outputFileName,outputFile
Set objFSO=CreateObject("Scripting.FileSystemObject")
If objFSO Is Nothing Then
WScript.Echo "Chyba pri vytvareni FileSystemObject."
WScript.Quit 1
End If
strFolderPath=objFSO.GetAbsolutePathName(".")
On Error Resume Next
Set objFolder=objFSO.GetFolder(strFolderPath)
If Err.Number<>0 Then
WScript.Echo "Chyba pri ziskavani slozky: "&Err.Description
WScript.Quit 1
End If
On Error GoTo 0
Set colFiles=objFolder.Files
strBaseName=InputBox("Zadej pevnou cast nazvu souboru:","Zadani nazvu souboru")
If strBaseName="" Then
WScript.Echo "Nebyl zadany zadny nazev. Skript se ukoncuje."
WScript.Quit 1
End If
ReDim arrFiles(colFiles.Count-1)
i=0
For Each objFile In colFiles
If LCase(objFSO.GetExtensionName(objFile.Name))="mp3" Then
Set arrFiles(i)=objFile
i=i+1
End If
Next
ReDim Preserve arrFiles(i-1)
For i=0 To UBound(arrFiles)-1
For j=i+1 To UBound(arrFiles)
If arrFiles(i).DateCreated>arrFiles(j).DateCreated Then
Set objFile=arrFiles(i)
Set arrFiles(i)=arrFiles(j)
Set arrFiles(j)=objFile
End If
Next
Next
strFileList=""
For i=0 To UBound(arrFiles)
Set objFile=arrFiles(i)
strNewFileName=strBaseName&Right("0000"& (i+1),4)&".mp3"
If LCase(objFile.Name)<>LCase(strNewFileName) Then
objFile.Name=strNewFileName
End If
strFileList=strFileList&strNewFileName&vbCrLf
Next
outputFileName=strFolderPath&"\seznam_souboru.txt"
On Error Resume Next
Set outputFile=objFSO.CreateTextFile(outputFileName,True)
If Err.Number<>0 Then
WScript.Echo "Chyba pri vytvareni textoveho souboru: "&Err.Description
WScript.Quit 1
End If
On Error GoTo 0
outputFile.Write strFileList
outputFile.Close
Set objFile=Nothing
Set objFolder=Nothing
Set objFSO=Nothing
Set outputFile=Nothing
WScript.Echo "Seznam souboru byl ulozen do " & outputFileName
Odpovědět

Zpět na „Software“