Объединение файлов doc - без использования UDF Word.au3

[RipVanWinkel]

Здравствуйте.
Есть код:

Спойлер

#include <Word.au3>
#include <Array.au3>
#include <File.au3>


 $oWord = _Word_Create()        ; Создать Новый экземпляр Word

 ; Создать и открыть итоговый файл
 $oDoc=_Word_DocAdd($oWord)
 _Word_DocSaveAs($oDoc,@ScriptDir&'\itog')
 _Word_DocClose($oDoc)
 $oDoc=_Word_DocOpen($oWord,@ScriptDir&'\itog.doc')   ; Открыть Word документ
 If @error Then Exit MsgBox(16, "Ошибка открытия", @ScriptDir&'\itog.doc')

Local $afiles
_FileReadToArray(@ScriptDir&'\'&'files.txt', $afiles)
;_ArrayDisplay($afiles)
For $i=1 To $afiles[0]
    $Path=StringStripWS($afiles[$i],3)
    If $Path<>'' Then ReadWord($Path)
Next



Func ReadWord($Path)
    $oDocTemp=_Word_DocOpen($oWord,$Path)   ; Открыть Word документ
    If @error Then Exit MsgBox(16, "Ошибка открытия", $Path)
    $oDocTemp.Range().CopyAsPicture()       ; Выделение и Копирование текста в ворде как изображения.
    $oRange = _Word_DocRangeSet($oDoc, -2)  ; Устанавливает курсор в Конец итогового файла
    $oRange.Paste() ; Вставка содержимого буфера обмена.
    $oRange = _Word_DocRangeSet($oDoc, -2)  ; Устанавливает курсор в Конец итогового файла
;~  $oRange.Select  ; Выделить
    $oRange.InsertBreak($wdLineBreak) ; Enter
    $oRange.InsertBreak($wdPageBreak) ; Разрыв страницы
    _Word_DocClose($oDocTemp)
EndFunc

Этот код собирает файлы doc - по списку files.txt в один файл.
То есть он выборочно объединяет некоторые файлы doc - в общий файл itog.doc

Как сделать, в точности такое же, объединение файлов doc - без использования UDF Word.au3 - простыми комбинациями клавиш (эмуляцией) - собирающий содержимое файлов - в общий файл doc - itog.doc по files.txt ?

То есть - открытие сразу всех файлов doc из списка, а потом перемещение между ними в определенном порядке с операцией копипаста: активировать первое по списку окно, Ctrl+A, Ctrl+C, активировать окно itog.doc - Ctrl+End, Ctrl+V.... затем следующее по списку окно.

 

[pvnn]

То есть - открытие сразу всех файлов doc из списка

У вас там 100 или 1000 и вы хотите все сразу открыть?

Как вариант, можно открывать по очереди файлы, копировать их в буфер обмена, потом закрывать, далее вставлять из буфера обмена в итоговый файл.

Спойлер

#include <File.au3>
 #include <Array.au3>
AutoItSetOption('WinTitleMatchMode',-2)

; Открыть итоговый файл
$ItogName='Итог.docx'
$ItogPath=@ScriptDir&'\'&$ItogName
	ShellExecute($ItogPath)
	WinWaitActive($ItogName)
	Send("^{END}")	; Переместиться в конец документа


Local $afiles
_FileReadToArray(@ScriptDir&'\'&'files.txt', $afiles)
;_ArrayDisplay($afiles)
For $i=1 To $afiles[0]
    $Path=StringStripWS($afiles[$i],3)
    If $Path<>'' Then ReadWord($Path)
Next

MsgBox(64,'Внимание','Обработка завершена')
Exit


Func ReadWord($Path)
	ShellExecute($Path)
	$sFileName = StringRegExpReplace($Path, '^.*\\', '') ; FileName.ext
	WinWaitActive($sFileName)
	Send("^a")		; Выделить все
	Send("^{INS}")  ; Копировать в буфер обмена
	Sleep(300)
	Send("^{F4}")	; Закрыть

	; Запись в Итог
	WinActivate($ItogName)
	Send("^{END}")	; Переместиться в конец документа
	Send("{ENTER}")	; Enter
	Send("+{INS}")  ; Вставить из буфера обмена
EndFunc

Файл 'Итог.docx' должен существовать



Добавлено:

Сообщение автоматически объединено: 9 Апр 2018

Интересно, а зачем вам такие сложности с эмуляцией клавиш? Чем вам решение через UDF Word.au3 не устраивает?

 

[RipVanWinkel]

pvnn, не работает.
Создает в итоговом файле вот такую абракадабру, написанную иероглифами.

В общем в вашем коде - обнаружил такую вещь: не срабатывает команда Send("^a")
Как это можно исправить?



Добавлено:

Сообщение автоматически объединено: 9 Апр 2018

pvnn, вот смотрите.
В вашем коде - почему-то не срабатывает Send("^a")

Чтобы проверить это я добавил в конце клавишу сохранения Send("^s"). Тоже не сработало.
Тогда я добавил функцию перехвата клавиш Func _LoadKeyboardLayoutEngSelf() - чтобы сделать эти Send - работоспособными.

Спойлер

_LoadKeyboardLayoutEngSelf()
#include <File.au3>
 #include <Array.au3>
AutoItSetOption('WinTitleMatchMode',-2)

; Открыть итоговый файл
$ItogName='Итог.doc'
$ItogPath=@ScriptDir&'\'&$ItogName
    ShellExecute($ItogPath)
    WinWaitActive($ItogName)
    Send("^{END}")  ; Переместиться в конец документа


Local $afiles
_FileReadToArray(@ScriptDir&'\'&'files.txt', $afiles)
;_ArrayDisplay($afiles)
For $i=1 To $afiles[0]
    $Path=StringStripWS($afiles[$i],3)
    If $Path<>'' Then ReadWord($Path)
Next

MsgBox(64,'Внимание','Обработка завершена')
Exit


Func ReadWord($Path)
    ShellExecute($Path)
    $sFileName = StringRegExpReplace($Path, '^.*\\', '') ; FileName.ext
    WinWaitActive($sFileName)
Sleep(1000)
    Send("^a")      ; Выделить все
Sleep(1000)
    Send("^{INS}")  ; Копировать в буфер обмена
 Sleep(300)
    Send("^{F4}")   ; Закрыть

    ; Запись в Итог
    WinActivate($ItogName)
    Send("^{END}")  ; Переместиться в конец документа
    Send("{ENTER}") ; Enter
    Send("+{INS}")  ; Вставить из буфера обмена
	Send("^s")  ; Сохранить
 EndFunc


 Func _LoadKeyboardLayoutEngSelf()
    Local Const $__KLF_ACTIVATE = 0x00000001, $__KLF_SETFORPROCESS = 0x00000100
    Local $a_Res = DllCall('user32.dll', 'long', 'LoadKeyboardLayoutW', 'wstr', '00000409', 'uint', BitOR($__KLF_ACTIVATE, $__KLF_SETFORPROCESS))
    If (@error) Or (Not $a_Res[0]) Then Return 0
    Return 1
EndFunc   ;==>_LoadKeyboardLayoutEngSelf

В этом случае - Send("^s") стала срабатывать.
Но Send("^a") - по-прежнему не работает.
Как это можно исправить ?

 

[pvnn]

Сделайте раскладку по умолчанию - Английская.
на Win7 все работает

 

[RipVanWinkel]

Ясно.
Спасибо.