4 kwi 2008

Konwersja nazw plików w wybranym folderze na katakanę

Konwersja nazw plików na katakanę

Dim fso, file, file_r, objF
Dim tables,trs,tds
Set fso = CreateObject("Scripting.FileSystemObject")
plik = "wartosci.txt"
folder = "E:\pliki\"
folder_tmp = folder & "tmp_rn\"
Set file = fso.CreateTextFile(plik, True, False)
Set objF = fso.GetFolder(folder)
Set colF = objF.Files
If fso.FolderExists(folder_tmp) = False Then
fso.CreateFolder(folder_tmp)
End If
For Each plik in colF
If fso.FileExists(plik) = True Then
nazwa = plik.Name
nazwa2 = nazwa
nazwa2 = Replace(nazwa2, "Ą","A")
nazwa2 = Replace(nazwa2, "Ć","C")
nazwa2 = Replace(nazwa2, "Ę","E")
nazwa2 = Replace(nazwa2, "Ł","L")
nazwa2 = Replace(nazwa2, "Ń","N")
nazwa2 = Replace(nazwa2, "Ó","O")
nazwa2 = Replace(nazwa2, "Ś","S")
nazwa2 = Replace(nazwa2, "Ź","Z")
nazwa2 = Replace(nazwa2, "Ż","Z")
nazwa2 = Replace(nazwa2, "ą","a")
nazwa2 = Replace(nazwa2, "ć","c")
nazwa2 = Replace(nazwa2, "ę","e")
nazwa2 = Replace(nazwa2, "ł","l")
nazwa2 = Replace(nazwa2, "ń","n")
nazwa2 = Replace(nazwa2, "ó","o")
nazwa2 = Replace(nazwa2, "ś","s")
nazwa2 = Replace(nazwa2, "ź","z")
nazwa2 = Replace(nazwa2, "ż","z")
nazwa2 = Replace(nazwa2, " ","_")
nazwa2 = Replace(nazwa2, "&","_")
file.WriteLine(nazwa & " " & nazwa2)
plik_new = folder_tmp & nazwa2
If fso.FileExists(plik_new) = False Then
fso.CopyFile plik, plik_new
End If
End If
Next
file.Close
WScript.echo "Koniec"