1

Тема: VBS: Переименование в транслит файлов всей структуры каталога

Здравствуйте. Есть скрипт который ищет файлы в папке и подпапках и переименовывает файлы как имя папки + имя файла, а также переводит имя в транслит и удоляет символы. Проблема в том что если файлов грубо говоря десять или меньше все работает как надо, а если файлов много то переименование идет неправельно как т как имя папки+имя папки+имя папки+имя папки+имя папки+имя папки+имя файла. Скрипт вываливается с ошибкой не найден путь. Подскажите как это исправить или в какую сторону смотреть.

Сам скрипт:
(Чтобы работала функция Rus2Lat файл скрипта должен быть в кодировке Windows-1251)


tmpFolder = "c:\tmp\"

FilesRename tmpFolder

WScript.Echo "Готово"

Function FilesRename(tmpPath)
 Dim frFolder, frFile, frSubFolder, frName
 If Len(tmpPath) <> 0 Then
    Set objFSO = WScript.CreateObject("Scripting.FileSystemObject")    
    If objFSO.FolderExists(tmpPath) Then
		Set frFolder = objFSO.GetFolder(tmpPath)
        For Each frFile In frFolder.Files
			If UCase(objFSO.GetExtensionName(frFile.Name)) = UCase("jpg") Then
				frName = LCase(Rus2Lat(frFolder.Name))
				frName = frName & "_" & LCase(Rus2Lat(objFSO.GetBaseName(frFile.Name)))
				frName = Replace (frName," ","_")
			   frName = Replace (frName,")","")
			   frName = Replace (frName,"(","")
			   frName = Replace (frName,",","")
			   frName = Replace (frName,".","")
			   frFile.Name = frName & ".jpg"
			End If
		Next
	End If	
			For Each frSubFolder In frFolder.SubFolders
			FilesRename(frSubFolder)
			Next
 End If 
End Function

Function Rus2Lat(strRus)
    Dim i
    Dim strTemp
    Dim strLat
    For i = 1 To Len(strRus)
        strTemp = Mid(strRus, i, 1)             
        Select Case strTemp
            Case "а"
                strLat = strLat & "a"
            Case "А"
                strLat = strLat & "A"
            Case "б"
                strLat = strLat & "b"
            Case "Б"
                strLat = strLat & "B"
            Case "в"
                strLat = strLat & "v"
            Case "В"
                strLat = strLat & "V"
            Case "г"
                strLat = strLat & "g"
            Case "Г"
                strLat = strLat & "G"
            Case "д"
                strLat = strLat & "d"
            Case "Д"
                strLat = strLat & "D"
            Case "е"
                strLat = strLat & "e"
            Case "Е"
                strLat = strLat & "E"
            Case "ё"
                strLat = strLat & "yo"
            Case "Ё"
                strLat = strLat & "Yo"
            Case "ж"
                strLat = strLat & "zh"
            Case "Ж"
                strLat = strLat & "Zh"
            Case "з"
                strLat = strLat & "z"
            Case "З"
                strLat = strLat & "Z"
            Case "и"
                strLat = strLat & "i"
            Case "И"
                strLat = strLat & "I"
            Case "й"
                strLat = strLat & "i"
            Case "Й"
                strLat = strLat & "I"
            Case "к"
                strLat = strLat & "k"
            Case "К"
                strLat = strLat & "K"
            Case "л"
                strLat = strLat & "l"
            Case "Л"
                strLat = strLat & "L"
            Case "м"
                strLat = strLat & "m"
            Case "М"
                strLat = strLat & "M"
            Case "н"
                strLat = strLat & "n"
            Case "Н"
                strLat = strLat & "N"
            Case "о"
                strLat = strLat & "o"
            Case "О"
                strLat = strLat & "O"
            Case "п"
                strLat = strLat & "p"
            Case "П"
                strLat = strLat & "P"
            Case "р"
                strLat = strLat & "r"
            Case "Р"
                strLat = strLat & "R"
            Case "с"
                strLat = strLat & "s"
            Case "С"
                strLat = strLat & "S"
            Case "т"
                strLat = strLat & "t"
            Case "Т"
                strLat = strLat & "T"
            Case "у"
                strLat = strLat & "u"
            Case "У"
                strLat = strLat & "U"
            Case "ф"
                strLat = strLat & "f"
            Case "Ф"
                strLat = strLat & "F"
            Case "х"
                strLat = strLat & "kh"
            Case "Х"
                strLat = strLat & "Kh"
            Case "ц"
                strLat = strLat & "ts"
            Case "Ц"
                strLat = strLat & "Ts"
            Case "ч"
                strLat = strLat & "ch"
            Case "Ч"
                strLat = strLat & "Ch"
            Case "ш"
                strLat = strLat & "sh"
            Case "Ш"
                strLat = strLat & "Sh"
            Case "щ"
                strLat = strLat & "sch"
            Case "Щ"
                strLat = strLat & "Sch"
            Case "ъ"
                strLat = strLat & ""
            Case "Ъ"
                strLat = strLat & ""
            Case "ы"
                strLat = strLat & "y"
            Case "Ы"
                strLat = strLat & "Y"
            Case "ь"
                strLat = strLat & ""
            Case "Ь"
                strLat = strLat & ""
            Case "э"
                strLat = strLat & "e"
            Case "Э"
                strLat = strLat & "E"
            Case "ю"
                strLat = strLat & "yu"
            Case "Ю"
                strLat = strLat & "Yu"
            Case "я"
                strLat = strLat & "ya"
            Case "Я"
                strLat = strLat & "Ya"
            Case Else
                'unknown symbol
                strLat = strLat & strTemp
        End Select
    Next
    Rus2Lat = strLat
	End Function

2

Re: VBS: Переименование в транслит файлов всей структуры каталога

Всё до Function Rus2Lat(strRus) заменяйте:

Option Explicit
Dim tmpFolder, objFSO, objShell, objRegExp

tmpFolder = "c:\tmp\"

Set objFSO    = CreateObject("Scripting.FileSystemObject")
Set objShell  = CreateObject("Shell.Application")
Set objRegExp = New Regexp : objRegExp.Global = True
objRegExp.Pattern = "[().,]"

FilesRename tmpFolder
WScript.Echo "Готово"

Sub FilesRename(tmpPath)
	Dim Items, frFile, frSubFolder, frName
	Set Items = objShell.NameSpace(tmpPath).Items
	Items.Filter 8384, "*.jpg"
	If Items.Count Then
		For Each frFile in Items
			frName = objRegExp.Replace(Replace(LCase(Rus2Lat(objFSO.GetFileName(tmpPath) &_
			"_" & objFSO.GetBaseName(frFile))), " ", "_"), "") & ".jpg"
			If Not objFSO.FileExists(objFSO.BuildPath(tmpPath, frName)) Then frFile.Name = frName
		Next
	End If : Items.Filter 8352, "*"
	For Each frSubFolder in Items : FilesRename frSubFolder.Path : Next
End Sub

Заголовок исправлен на тематический.

3

Re: VBS: Переименование в транслит файлов всей структуры каталога

Cпасибо.