Войти

Показать полную графическую версию : [решено] Переименование файлов в соотвествии с их заголовком


daniil1018
02-04-2014, 21:30
Здравствуйте. Множество документов (почти 200) имеет такой вид: Found_22914216_32256.docx
Как можно автоматизировать их переименование по заголовку?

daniil1018
04-04-2014, 21:59
Никто так и не ответит?

Iska
04-04-2014, 22:27
daniil1018, в рамках заданной категории сие малореально. Тут нужен Automation — WSH, PoSH и т.п.

Если интересует — сразу укажите, что делать, если заголовки будут дублироваться.

Множество документов (почти 200) имеет такой вид: Found_22914216_32256.docx »
Речь только про документы Microsoft Word или …?

daniil1018
05-04-2014, 08:41
Automation — WSH, PoSH и т.п » можно и так
Речь только про документы Microsoft Word или …? » да, документы word

Iska
05-04-2014, 14:03
daniil1018, Вы не ответили:
Если интересует — сразу укажите, что делать, если заголовки будут дублироваться. »
Вы вынуждаете меня принимать решения самолично — будем уведомлять и пропускать.

Как-то так, пробуйте:
Option Explicit

Dim strSourceFolder

Dim objFile

Dim objWord

Dim strTitle
Dim strNewName


strSourceFolder = "E:\Песочница\0372"

With WScript.CreateObject("Scripting.FileSystemObject")
If .FolderExists(strSourceFolder) Then
Set objWord = Nothing

For Each objFile In .GetFolder(strSourceFolder).Files
Select Case LCase(.GetExtensionName(objFile.Name))
Case "doc", "docx"
WScript.Echo objFile.Name

If objWord Is Nothing Then
Set objWord = WScript.CreateObject("Word.Application")
End If

With objWord.Documents.Open(objFile.Path)
strTitle = Trim(.BuiltInDocumentProperties.Item("Title").Value)
.Close
End With

If Len(strTitle) > 0 Then
WScript.Echo vbTab, "Title:", strTitle

strTitle = Replace(strTitle, "\", "_")
strTitle = Replace(strTitle, "/", "_")
strTitle = Replace(strTitle, ":", "-")
strTitle = Replace(strTitle, "*", "_")
strTitle = Replace(strTitle, "?", "_")
strTitle = Replace(strTitle, """", "'")
strTitle = Replace(strTitle, "<", "«")
strTitle = Replace(strTitle, ">", "»")
strTitle = Replace(strTitle, "|", "_")

If .GetBaseName(objFile.Name) <> strTitle Then
strNewName = strTitle & "." & .GetExtensionName(objFile.Name)

If .FileExists(.BuildPath(strSourceFolder, strNewName)) Then
WScript.Echo vbTab, "New file name [" & strNewName & "] already exists in [" & strSourceFolder & "] - skipping rename."
Else
WScript.Echo vbTab, "New file name [" & strNewName & "]."
objFile.Name = strNewName
End If
Else
WScript.Echo vbTab, "File name equal title already - nothing to do."
End If
Else
WScript.Echo vbTab, "Empty title - skipping."
End If
Case Else
' Nothing to do
End Select
Next

If Not objWord Is Nothing Then
objWord.Quit
Set objWord = Nothing
End If
Else
WScript.Echo "Source folder [" & strSourceFolder & "] not found."
WScript.Quit 1
End If
End With

WScript.Quit 0

daniil1018
05-04-2014, 19:12
Iska, Ладно, пусть пропускает, но на некоторых файлах выводит сообщение "Empty title - skipping"

Iska
05-04-2014, 21:37
но на некоторых файлах выводит сообщение "Empty title - skipping" »
Пустое значение поля «Заголовок» — свойства «.BuiltInDocumentProperties.Item("Title")». Не на что переименовывать. Оттого и пропускаем.




© OSzone.net 2001-2012