daniil1018, Вы не ответили:
Цитата:
Цитата Iska
Если интересует — сразу укажите, что делать, если заголовки будут дублироваться. »
|
Вы вынуждаете меня принимать решения самолично — будем уведомлять и пропускать.
Как-то так, пробуйте:
читать дальше »
Код:
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
|
