Что нового

Переименовать файл ворда строкой из первого титульного листа

Grizli

Новичок
Сообщения
48
Репутация
2
Версия AutoIt: 3.3.14.5

Описание:
Здравствуйте уважаемые. Помогите реализовать такую интересную задачу- На работе человек удалил папку со всеми своими документами. Восстановил, и там около трех тысяч одних только вордовских файлов doc,docx,rtf, все имеют маску filexxx. Нужно как-то проверить, если первый лист титульный, то переименовать файл как указано в середине титульного листа.
Примечания:
Думаю такой скрипт будет полезен многим. От ситуации, в которой оказалась женщина с работы, не застраховано большинство обычных пользователей пк.
 
  • Like
Реакции: Zuzu

hedji

Продвинутый
Сообщения
408
Репутация
88
Код:
#include <File.au3>
#include <Word.au3>

$sFileSelectFolder = FileSelectFolder("Выберете папку с файлами", "")
$files = _FileListToArray($sFileSelectFolder, "*.doc*", 1)
$oWord = _Word_Create()
For $i=1 To UBound($files)-1
	$exten=StringSplit($files[$i], ".", 2)
	$exten=$exten[UBound($exten)-1]
	$oDoc = _Word_DocOpen($oWord, $sFileSelectFolder & "\" & $files[$i], Default, Default, True)
	$oRangeFound = _Word_DocRangeSet($oDoc, -1, $wdParagraph, -1, Default, 100) ;на случай форматирования пробелами и переводами строки берем первые несколько строк
	$strs = $oRangeFound.Text
	$strs = StringRegExp($strs, "(.*)\R", 3)
	For $str in $strs
		If StringLen($str)>10 Then ;ищем первую строку, которая будет длиннее 10 символов и используем её в качестве имени нового файла
			$title = $str
			ExitLoop
		EndIf
	Next
    _Word_DocClose($oDoc)
	FileMove ($sFileSelectFolder & "\" & $files[$i], $sFileSelectFolder & "\" & $title & "." & $exten, 1)
Next
_Word_Quit($oWord)
 

hedji

Продвинутый
Сообщения
408
Репутация
88
В зависимости от того, что именно у вас в титульных листах.
Вариант "выдернуть из середины":
Код:
#include <File.au3>
#include <Word.au3>

$sFileSelectFolder = FileSelectFolder("Выберете папку с файлами", "")
$files = _FileListToArray($sFileSelectFolder, "*.doc*", 1)
$oWord = _Word_Create()
For $i=1 To UBound($files)-1
	$exten=StringSplit($files[$i], ".", 2)
	$exten=$exten[UBound($exten)-1]
	$oDoc = _Word_DocOpen($oWord, $sFileSelectFolder & "\" & $files[$i], Default, Default, True)
	$oRangeFound = _Word_DocRangeSet($oDoc, -1, $wdParagraph, 13, Default, 100) ;на случай форматирования пробелами и переводами строки берем первые несколько строк
	$strs = $oRangeFound.Text
	$strs = StringRegExp($strs, "(.*)\R", 3)
	For $str in $strs
		If StringLen($str)>30 Then
			$title = $str
			ExitLoop
		EndIf
	Next
	$title=StringRegExpReplace($title, ":", "_")
    _Word_DocClose($oDoc)
	FileMove ($sFileSelectFolder & "\" & $files[$i], $sFileSelectFolder & "\" & $title & "." & $exten, 1)
Next
_Word_Quit($oWord)

Вариант "найти слова Тема и использовать её"
Код:
#include <File.au3>
#include <Word.au3>

$sFileSelectFolder = FileSelectFolder("Выберете папку с файлами", "")
$files = _FileListToArray($sFileSelectFolder, "*.doc*", 1)
$oWord = _Word_Create()
For $i=1 To UBound($files)-1
	$exten=StringSplit($files[$i], ".", 2)
	$exten=$exten[UBound($exten)-1]
	$oDoc = _Word_DocOpen($oWord, $sFileSelectFolder & "\" & $files[$i], Default, Default, True)
	$oRangeFound = _Word_DocRangeSet($oDoc, -1, $wdParagraph, -1, Default, 100) ;на случай форматирования пробелами и переводами строки берем первые несколько строк
	$strs = $oRangeFound.Text
	$strs = StringRegExp($strs, "(.*)\R", 3)
	For $str in $strs
		If StringInStr($str, "Тема") Then
			$title = $str
			ExitLoop
		EndIf
	Next
	$title=StringRegExpReplace($title, ":", "_")
    _Word_DocClose($oDoc)
	FileMove ($sFileSelectFolder & "\" & $files[$i], $sFileSelectFolder & "\" & $title & "." & $exten, 1)
Next
_Word_Quit($oWord)
 
Автор
G

Grizli

Новичок
Сообщения
48
Репутация
2
спасибо, Вариант "выдернуть из середины" подходит. Подскажите, а как сделать чтобы алгоритм скрипта не реагировал на обычные документы, без титульника? А то их названия часто больше путают, чем помогают. Пусть уж лучше имеют безликие названия
 

hedji

Продвинутый
Сообщения
408
Репутация
88
Тут простор для творчества, в первую очередь вашего. :smile:
Скрипт в любом случае получит некий текстовый массив из первой страницы файла.
Далее необходимо придумать условие, по которому он сможет решить какая часть из этого массива станет названием.
Я не знаю что именно у вас за файлы, если все 3000 документов это дипломные работы, которые точно содержат на титульном листе слово "Тема", я бы применил вариант "найти слова Тема и использовать её".
Если дипломные работы вперемешку со случайными файлами - зависит от содержания самих файлов, можно например пройтись по файлам вариантом с поиском темы, потом переименованные файлы переместить в другую папку и пройтись по оставшимся вариантом с переименованием по первой строке.
Можно попробовать определять наличие титульного листа по наличию большого количества пустых строк (в приложенном примере форматирование производится переводом строки) или наличию слов РФ, Екатеринбург, Мин. Обр. или еще каких-то, но все равно остается вопрос что делать с оставшимися.
 

Bukabet

Новичок
Сообщения
2
Репутация
2
Код:
#include <File.au3>
#include <Word.au3>

$sFileSelectFolder = FileSelectFolder("Выберете папку с файлами", "")
$files = _FileListToArray($sFileSelectFolder, "*.doc*", 1)
$oWord = _Word_Create()
For $i=1 To UBound($files)-1
    $exten=StringSplit($files[$i], ".", 2)
    $exten=$exten[UBound($exten)-1]
    $oDoc = _Word_DocOpen($oWord, $sFileSelectFolder & "\" & $files[$i], Default, Default, True)
    $oRangeFound = _Word_DocRangeSet($oDoc, -1, $wdParagraph, -1, Default, 100) ;на случай форматирования пробелами и переводами строки берем первые несколько строк
    $strs = $oRangeFound.Text
    $strs = StringRegExp($strs, "(.*)\R", 3)
    For $str in $strs
        If StringLen($str)>10 Then ;ищем первую строку, которая будет длиннее 10 символов и используем её в качестве имени нового файла
            $title = $str
            ExitLoop
        EndIf
    Next
    _Word_DocClose($oDoc)
    FileMove ($sFileSelectFolder & "\" & $files[$i], $sFileSelectFolder & "\" & $title & "." & $exten, 1)
Next
_Word_Quit($oWord)
Код отлично работает, но есть одно но. Если есть файлы, которые с одинаковыми первыми строками он их перезаписывает, то есть удаляет напрочь.
Если у вас около 900 файлов без имен как у меня, создайте копию папки для переименования файлов.
На данный момент требуется решение чтобы файлу в конце добавлялось цифра. К примеру Есть файл Призма, далее он создает Призма(1), Призма(2) итд, на данный момент просто идет перезапись
 
  • Like
Реакции: Zuzu

xXx

Меценат
Меценат
Сообщения
166
Репутация
55
требуется решение чтобы файлу в конце добавлялось цифра.
Небольшая доработка кода hedji
Код:
#include <File.au3>
#include <Word.au3>
#include <WinAPIShPath.au3>

Global $sTitle, $sFileSelectFolder, $strs, $files, $sExten, $sExten, $oDoc, $oRangeFound, $oWord

$sFileSelectFolder = FileSelectFolder("Выберете папку с файлами", @ScriptDir)
If Not $sFileSelectFolder Then Exit
$files = _FileListToArray($sFileSelectFolder, "*.doc*", 1)
$oWord = _Word_Create(False)
For $i = 1 To UBound($files) - 1
    $sExten = _WinAPI_PathFindExtension($files[$i])
    $oDoc = _Word_DocOpen($oWord, $sFileSelectFolder & "\" & $files[$i], Default, Default, True)
    $oRangeFound = _Word_DocRangeSet($oDoc, -1, $wdParagraph, -1, Default, 100) ;на случай форматирования пробелами и переводами строки берем первые несколько строк
    $strs = $oRangeFound.Text
    $strs = StringRegExp($strs, "(.*)\R", 3)
    For $str In $strs
        If StringLen($str) > 10 Then ;ищем первую строку, которая будет длиннее 10 символов и используем её в качестве имени нового файла
            $sTitle = $str
            ExitLoop
        EndIf
    Next
    _Word_DocClose($oDoc)
    $sTitle = StringRegExpReplace($sTitle, '[\\/:*?"<>|]', '_')
    $sFileNew = _WinAPI_PathYetAnotherMakeUniqueName($sFileSelectFolder & "\" & $sTitle & $sExten)
    If $sFileNew Then FileMove($sFileSelectFolder & "\" & $files[$i], $sFileNew, 1)
Next
_Word_Quit($oWord)
 

Zuzu

Новичок
Сообщения
1
Репутация
1
Небольшая доработка кода hedji
Код:
#include <File.au3>
#include <Word.au3>
#include <WinAPIShPath.au3>

Global $sTitle, $sFileSelectFolder, $strs, $files, $sExten, $sExten, $oDoc, $oRangeFound, $oWord

$sFileSelectFolder = FileSelectFolder("Выберете папку с файлами", @ScriptDir)
If Not $sFileSelectFolder Then Exit
$files = _FileListToArray($sFileSelectFolder, "*.doc*", 1)
$oWord = _Word_Create(False)
For $i = 1 To UBound($files) - 1
    $sExten = _WinAPI_PathFindExtension($files[$i])
    $oDoc = _Word_DocOpen($oWord, $sFileSelectFolder & "\" & $files[$i], Default, Default, True)
    $oRangeFound = _Word_DocRangeSet($oDoc, -1, $wdParagraph, -1, Default, 100) ;на случай форматирования пробелами и переводами строки берем первые несколько строк
    $strs = $oRangeFound.Text
    $strs = StringRegExp($strs, "(.*)\R", 3)
    For $str In $strs
        If StringLen($str) > 10 Then ;ищем первую строку, которая будет длиннее 10 символов и используем её в качестве имени нового файла
            $sTitle = $str
            ExitLoop
        EndIf
    Next
    _Word_DocClose($oDoc)
    $sTitle = StringRegExpReplace($sTitle, '[\\/:*?"<>|]', '_')
    $sFileNew = _WinAPI_PathYetAnotherMakeUniqueName($sFileSelectFolder & "\" & $sTitle & $sExten)
    If $sFileNew Then FileMove($sFileSelectFolder & "\" & $files[$i], $sFileNew, 1)
Next
_Word_Quit($oWord)
Спасибо, за работу! Жалко не видно когда скрипт завершает работу и бывает выдает ошибку на 15 строку, связано с защищенностью файла, приходится искать файл в ручную. Но скрипт стал заметно лучше.
 

Bukabet

Новичок
Сообщения
2
Репутация
2
Небольшая доработка кода hedji
Код:
#include <File.au3>
#include <Word.au3>
#include <WinAPIShPath.au3>

Global $sTitle, $sFileSelectFolder, $strs, $files, $sExten, $sExten, $oDoc, $oRangeFound, $oWord

$sFileSelectFolder = FileSelectFolder("Выберете папку с файлами", @ScriptDir)
If Not $sFileSelectFolder Then Exit
$files = _FileListToArray($sFileSelectFolder, "*.doc*", 1)
$oWord = _Word_Create(False)
For $i = 1 To UBound($files) - 1
    $sExten = _WinAPI_PathFindExtension($files[$i])
    $oDoc = _Word_DocOpen($oWord, $sFileSelectFolder & "\" & $files[$i], Default, Default, True)
    $oRangeFound = _Word_DocRangeSet($oDoc, -1, $wdParagraph, -1, Default, 100) ;на случай форматирования пробелами и переводами строки берем первые несколько строк
    $strs = $oRangeFound.Text
    $strs = StringRegExp($strs, "(.*)\R", 3)
    For $str In $strs
        If StringLen($str) > 10 Then ;ищем первую строку, которая будет длиннее 10 символов и используем её в качестве имени нового файла
            $sTitle = $str
            ExitLoop
        EndIf
    Next
    _Word_DocClose($oDoc)
    $sTitle = StringRegExpReplace($sTitle, '[\\/:*?"<>|]', '_')
    $sFileNew = _WinAPI_PathYetAnotherMakeUniqueName($sFileSelectFolder & "\" & $sTitle & $sExten)
    If $sFileNew Then FileMove($sFileSelectFolder & "\" & $files[$i], $sFileNew, 1)
Next
_Word_Quit($oWord)
Спасибо, намного лучше чем было. Теперь файлы открываются в фоновом режиме, а не каждый файл по отдельности во весь экран. И спасибо за решение проблемы с дублированием названий. Единственное что, когда возникает ошибка, хорошо
бы если было указано с каким файлом проблема, на данный момент ищется руками. Большое спасибо за апгрэйд.
 
  • Like
Реакции: Zuzu

xXx

Меценат
Меценат
Сообщения
166
Репутация
55
Жалко не видно когда скрипт завершает работу
хорошо бы если было указано с каким файлом проблема
Код:
#include <File.au3>
#include <Word.au3>
#include <WinAPIShPath.au3>

Global $sTitle, $sFileSelectFolder, $strs, $files, $sExten, $sExten, $oDoc, $oRangeFound, $oWord, $aFileError[1][3]

$sFileSelectFolder = FileSelectFolder("Выберете папку с файлами", @ScriptDir)
If Not $sFileSelectFolder Then Exit
$files = _FileListToArray($sFileSelectFolder, "*.doc*", 1)
$oWord = _Word_Create(False)
For $i = 1 To UBound($files) - 1
    $sTitle = ''
    $sExten = _WinAPI_PathFindExtension($files[$i])
    $oDoc = _Word_DocOpen($oWord, $sFileSelectFolder & '\' & $files[$i], Default, Default, True)
    If @error Then
        _FileError($sFileSelectFolder & '\' & $files[$i], 1)
        ContinueLoop
    EndIf
    $oRangeFound = _Word_DocRangeSet($oDoc, -1, $wdParagraph, -1, Default, 100) ;на случай форматирования пробелами и переводами строки берем первые несколько строк
    If @error Then
        _FileError($sFileSelectFolder & '\' & $files[$i], 2)
        _Word_DocClose($oDoc)
        ContinueLoop
    EndIf
    $strs = $oRangeFound.Text
    $strs = StringRegExp($strs, "(.*)\R", 3)
    For $str In $strs
        If StringLen($str) > 10 Then ;ищем первую строку, которая будет длиннее 10 символов и используем её в качестве имени нового файла
            $sTitle = $str
            ExitLoop
        EndIf
    Next
    _Word_DocClose($oDoc)
    If Not $sTitle Then
        _FileError($sFileSelectFolder & '\' & $files[$i], 3)
        ContinueLoop
    EndIf
    $sTitle = StringRegExpReplace($sTitle, '[\\/:*?"<>|]', '_')
    $sFileNew = _WinAPI_PathYetAnotherMakeUniqueName($sFileSelectFolder & "\" & $sTitle & $sExten)
    If Not $sFileNew Then
        _FileError($sFileSelectFolder & '\' & $files[$i], 4)
        ContinueLoop
    EndIf
    If $sFileNew And (Not FileMove($sFileSelectFolder & "\" & $files[$i], $sFileNew, 1)) Then _FileError($sFileSelectFolder & '\' & $files[$i], 5)
Next
_Word_Quit($oWord)

If $aFileError[0][0] Then
    _ArrayDisplay($aFileError, 'Процесс Завершен. Ошибки:', '1:' & $aFileError[0][0], Default, Default, 'Файл|Код Ошибки|Пояснения')
Else
    MsgBox(262144 + 64, Default, 'Процесс Успешно Завершен.')
EndIf

; === USER FUNCTIONS: =========================================
Func _FileError($sFile, $iErrorCode)
    Local $iUb = UBound($aFileError)

    ReDim $aFileError[$iUb + 1][3]
    $aFileError[0][0] = $iUb
    $aFileError[$iUb][0] = '".\' & $sFile & '"'
    $aFileError[$iUb][1] = $iErrorCode

    Switch $iErrorCode
        Case 1
            $aFileError[$iUb][2] = 'Не удалось открыть файл для чтения'
        Case 2
            $aFileError[$iUb][2] = 'Не удалось выделить текст в документе'
        Case 3, 4
            $aFileError[$iUb][2] = 'Не удалось сгенерировать новое имя документа'
        Case 5
            $aFileError[$iUb][2] = 'Не удалось переименовать документ'
    EndSwitch
EndFunc   ;==>_FileError
 
Последнее редактирование:
Верх