Тема: VBS: Пример получения свойств документов Офиса
Коллеги, представляю пример скрипта переименовывания документов Офиса на основании их свойств (автор, заголовок и проч.)
Предистория: после восстановления офисных файлов с зачищенного "нежданной" установкой операционки с нуля (глюк SCCM) винта программой "Restorer2000" в разделе восстановления "Lost Files" находятся восстановленые по типам данных файлы, но имена файлов - просто числовое перечисление, а даты всех файлов - это дата восстановления.
Написанный "на коленке" скрипт Rename_OfficeDoc.vbs пробует получить из вордов/экселей свойства: дату модификации, имена автора и последнего правившего документ, заголовок документа - и формирует из этого новое имя файла по шаблону:
ГГГГ-ММ-ДД_ччмм _(е)автор_последних_правок _(t)заголовок_документа _(a)автор_документа _(прежнее_имя).*
Если (a) совпадает с (e), то автора не показываем.
Этим скриптом я отсеял "битые" документы (где-то 10-20%), а на остальные - дал пользователю через переименование хоть какие-то намеки на содержимое и давность 4тыс. восстановленных документов, т.к. юзер видит документы в хронологии модификации и может понять - от кого получен, кем редактирован.
При работе скрипта используется объект "DSOFile.OleDocumentProperties" (регистрируем библиотеку dsofile.dll). Данная DLL в свободном скачивании - Microsoft Developer Support OLE File Property Reader 2.1 Sample (KB 224351) .
'--- RenamedDoc.vbs'
' Reading Document Properties, rename documents
' Путь к обрабатывемому каталогу'
' sFolder = "C:\Common\Develop\vbs\RenamedDoc\doc1"
' sFolder = "\\uachpc077\c$\!ins\_RECOVER_FROM_036\Microsoft Excel 2007 XML Document"
sFolder = "\\uachpc077\c$\!ins\_RECOVER_FROM_036\Microsoft Word 2007 XML Document"
gi_NeedTitle = 1 ' 1 - добавляем Title документа / 0 - не обрабатываем, если остались документы с заголовком в нечитабельной кодировки'
gi_NeedRename = 1 ' 1 - переименовываем документы / 0 - только формируем протокол (в папке документов) _log_RenamedDoc.txt с новыми именами'
Set fso = CreateObject("Scripting.FileSystemObject")
Set NewFile = fso.CreateTextFile( sFolder & "\_log_RenamedDoc.txt", True)
Set folder = fso.GetFolder(sFolder)
Set files = folder.Files
countDoc = 0 : countErr = 0 : countRen = 0
For each folderIdx In files
If ( InStr(folderIdx.Name,".xls")>0 OR InStr(folderIdx.Name,".doc")>0 ) AND Left(folderIdx.Name, 2)<>"~$" Then
countDoc = countDoc + 1
sOldName = folderIdx.Name
sLog = ""
sNewName = uf_newNameDocFile (sFolder, sOldName)
If sNewName=sOldName Then
countErr = countErr + 1
sLog = "(no_read)" & vbTab & sOldName & vbTab & "--"
Else
'--- переименование файла'
Err.Clear
On Error Resume Next
If gi_NeedRename=1 Then fso.MoveFile sFolder &"\"& sOldName, sFolder &"\"& sNewName
If Err.Number = 0 Then
countRen = countRen + 1
sLog = "(renamed)" & vbTab & sOldName & vbTab & sNewName
Else
countErr = countErr + 1
sLog = "(err_rename)" & vbTab & sOldName & vbTab & sNewName
End IF
On Error GoTo 0
End IF
NewFile.WriteLine( sLog )
End IF
Next
NewFile.Close
s = "Doc:" & Cstr(countDoc) & " Err:" & Cstr(countErr) & " Ren:" & Cstr(countRen)
msgbox s,,"Finish"
' --- Формирование нового имени файла'
' Параметры: путь к документу, имя файла документа (файл должен быть word/excel)
' Резульат - новое имя файла с добавленными слевой стороны имени файла свойствами офисного документа:
' дата, последний_редактировавший, заголовок, автор_документа (если отличен от редактировавшего)'
' --------------------------------------------------------------------------------------------------
Function uf_newNameDocFile (pPath, pName)
' Microsoft Developer Support OLE File Property Reader 2.1 Sample (KB 224351)
' http://www.microsoft.com/download/en/details.aspx?displaylang=en&id=8422
Dim objDoc : Set objDoc = CreateObject("DSOFile.OleDocumentProperties")
i = InStrRev( pName, "." )
sOld = Left( pName, i - 1) 'только имя файла'
ext = Right( pName, Len(pName) - i ) 'расширение файла'
s = ""
Err.Clear
On Error Resume Next
objDoc.Open( pPath & "\" & pName)
If Err.Number = 0 Then
sDt = "" 'время последнего редактирования в формате ГГГГ-ММ-ДД_ЧЧММ'
If len(Trim(objDoc.SummaryProperties.DateLastSaved))>0 Then
sDt = objDoc.SummaryProperties.DateLastSaved
sDt = Mid(sDt,7,4) & "-" & Mid(sDt,4,2) & "-" & Mid(sDt,1,2) & "_" & Replace(Mid(sDt,12,5),":","")
End IF
If len(sDt)>0 AND sDt<>"--_" Then s = s & sDt
If len(objDoc.SummaryProperties.LastSavedBy)>0 Then s = s & " _(e)"& objDoc.SummaryProperties.LastSavedBy
If gi_NeedTitle=1 Then 'есть требование обрабатывать Title'
If len(objDoc.SummaryProperties.Title)>0 Then
sTitle = Trim( Replace(Replace(objDoc.SummaryProperties.Title, vbTab,""), "|",""))
If sTitle="Number:" Then sTitle=""
If Len(sTitle)>0 Then s = s & " _(t)"& sTitle
End IF
End IF
If len(objDoc.SummaryProperties.Author)>0 AND (objDoc.SummaryProperties.Author<>objDoc.SummaryProperties.LastSavedBy) _
Then s = s & " _(a)"& objDoc.SummaryProperties.Author
' замены недопустимых и часто повторяемых символов'
s = Replace(s,"і","i") 'украинская литера на латинскую'
s = Replace(s,"“","`") 'разновидности кавычек'
s = Replace(s,"”","`")
s = Replace(s,"«","`")
s = Replace(s,"»","`")
s = Replace(s,"""","`")
s = Replace(s,"?","_") 'символы подстановок'
s = Replace(s,"*","_")
s = Replace(s,":","_")
s = Replace(s,"/","_")
s = Replace(s,"\","_")
s = Replace(s,"|","_")
s = Replace(s,"____","__") 'многократные дубли пробелов и подчеркиваний'
s = Replace(s,"____","__")
s = Replace(s,"____","__")
s = Replace(s," "," ")
s = Replace(s," "," ")
End IF
If Len(s)> 0 Then s = s & " (" & sOld& ")." & ext Else s = pName 'оставляем имя прежним, если свойства не были получены'
On Error GoTo 0
Set objDoc = Nothing
uf_newNameDocFile = s
End FUNCTIONСкрипт писался на скорую руку, поэтому нет передачи аргументов, обхода каталогов и прочего - в первых строках скрипта выполняются индивидуальные настройки. Обработка каталога с doc/docx/xls/xlsx выклядела так:
- правим путь к обрабатывемому каталогу
- запускаем скрипт, ждем сообщения "Финиш"
- переименованные файлы, выделив по маске *_*.* , перекладываем в другую папку
- анализируем в протоколе _log_RenamedDoc.txt записи "(err_rename)" - определяем, что может в Titlt мешать переименовать файл. Если в Title документа какая-то нечитабельная каша - отключаем в скрипте обработку свойства Title: gi_NeedTitle = 0
- Повторяем обработку, перенос переименованных файлов и анализ протокола. Если в логе остаются только записи "(no_read)", то оставшиеся непереименованые файлы - битые.
Пример файла протокола:
(no_read) 119880.doc --
(err_rename) 122475.doc 2003-09-26_1045 _(e)DokuchayevaL _(t)ПЕРЕЛІК ДОКУМЕНТІВ, НЕОБХІДНИХ ДЛЯ ВІДКРИТТЯ КОРПОРАТИВНОГО РАХУНКУ В НАЦІОНАЛЬНІЙ ВАЛЮТІ ТИПУ “Н” ТА РАХУНКУ В ІНОЗЕМНІЙ ВАЛЮ _(a)Gvozdyev Yuriy (122475).doc
(renamed) 128002.doc 2009-07-03_1050 _(e)NeduzhyiS _(t)Постачальник_ ПП `МОСТ-СЕРВІС` _(a)user (128002).doc
(renamed) 128462.doc 2009-11-23_1739 _(e)NeduzhyiS _(t)Оплата за рекламу в журналi ` Партнер -Черкаси` № 10-12, 2009 р (128462).doc
(renamed) 251401.doc 2011-10-12_1812 _(e)VietrovS _(t)Оплата за марки поштовi для регiонального вiддiлення АТ ` ОТП Банк` в м _(a)NeduzhyiS (251401).docМожет кому-то это пригодится. 
