[alpap]

я так понимаю список один и только имен которые надо хаотически раскидать файлам docx, так как первое имя первому файлу правильно звучит: первое по алфавиту имя в списке первому (по алфавиту, а может и нет, как по умолчанию выставлено ...?) файлу в папке.
например было:
Файл 149931
после выполнения кода:

Код:

@echo off
set "d=C:\papka"
set "exp=docx"
set "f=spisok.txt"

if "%~1" neq "" (call %* & exit /b)
call :# :#1
call :# :#2
exit /b

:#
 pushd "%d%"
  start "" cmd /c "%~f0 %*"
 popd
exit /b

:#1
 for /f "usebackq delims=" %%a in ("%f%") do call :#2 "%%a"
exit /b

:#2
 for /f "delims=" %%a in ('dir /a-d/b "*.%exp%"') do if "%%a" neq "" ren "%%a" "%~1%%~xa"
exit /b

стало:
Файл 149932
spisok.txt видно где, в кодировке 866
name.bat не важно где, в кодировке 866

или так можно, но кодировка тоже везде 866

Код:

@echo off
set "d=C:\papka"
set "exp=docx"
set "f=spisok.txt"

pushd "%d%"
 for /f "tokens=1* delims=[]" %%a in ('dir /a-d/b "*.%exp%"^|find /n /v ""') do call :rn "%%b" "%%a"
popd
pause& exit

:rn
 <"%f%" (for /f "tokens=1* delims=[]" %%a in ('find /n /v ""^|find "[%~2]"') do @ren "%~1" "%%b%~x1")
exit /b

[mcintosh55]

я так понимаю список один и только имен »

После слияния word документа с excel у меня получаеться много страничный файл
Я этот многостраничный файл word обрабатываю скриптом этот скрипт мне создает много файлов word (в каждом файле по 2 странице).
Пример файлов после обработки
обращение в суд1.docx
обращение в суд2.docx
обращение в суд3.docx
обращение в суд4.docx
и т.д.

У меня есть таблица excel которые служит для слияния в документом word в этой таблице есть столбик ФИО Я этот столбик копирую в блокнот и у меня получается:
Иванов Иван Иванович
Петров Артем Николаевич
Петренко Игорь Иванович
Сидоров Антон Владимирович
и т.д.

Мы берем первую строчку Иванов Иван Иванович и переименовываем обращение в суд1.docx у нас получается Иванов Иван Иванович.docx
берем вторую строчку Петров Артем Николаевич и переименовываем обращение в суд2.docx у нас получается Петров Артем Николаевич.docx
и так далее

[Iska]

mcintosh55, вот всё как всегда. Ну, что бы Вам стоило изложить Вашу основную проблему, а не выбранное Вами решение частной задачи, а? Надо править Ваш:

Я этот многостраничный файл word обрабатываю скриптом этот скрипт мне создает много файлов word (в каждом файле по 2 странице). »

(а ещё лучше увязать туда и сам первоначальный процесс слияния), а не играться в подобные игры.

[mcintosh55]

вот как только? Вы перелагаете дописать скрипт где он разбивает один большой файл на маленькие файлы дергать ФИО excel файла и сразу переименовывать файл на выходе?

[Iska]

Вы перелагаете дописать скрипт где он разбивает один большой файл на маленькие файлы дергать ФИО excel файла и сразу переименовывать файл на выходе? »

Я предлагаю решить задачу целиком: получение основного документа слияния, получение списка Excel, построение документа слияния, разбитие его на отдельные документы и сохранение этих документов сразу под потребными именами.

Ведь что у нас получается: мы знаем имена этих частей в момент слияния, мы даже можем узнать эти имена в момент сохранения отдельных частей (если они добавляются куда-либо в текст документа при слиянии, и мы знаем, куда именно).

[mcintosh55]

осталось понять как это запилить ))) слияние еще понятно а вот как потом при разбивки сохранять под нужным именем вот это вопрос

Код:

Sub SplitIntoPages()
Dim docMultiple As Document
Dim docSingle As Document
Dim rngPage As Range
Dim iCurrentPage As Integer
Dim iPageCount As Integer
Dim strNewFileName As String
Application.ScreenUpdating = False 'Makes the code run faster and reduces screen _
flicker a bit.
Set docMultiple = ActiveDocument 'Work on the active document _
(the one currently containing the Selection)
Set rngPage = docMultiple.Range 'instantiate the range object
iCurrentPage = 1
'get the document's page count
iPageCount = docMultiple.Content.ComputeStatistics(wdStatisticPages)
Do Until iCurrentPage > iPageCount
If iCurrentPage = iPageCount Then
rngPage.End = ActiveDocument.Range.End 'last page (there won't be a next page)
Else
'Find the beginning of the next page
'Must use the Selection object. The Range.Goto method will not work on a page
Selection.GoTo wdGoToPage, wdGoToAbsolute, iCurrentPage + 2
'Set the end of the range to the point between the pages
rngPage.End = Selection.Start
End If
rngPage.Copy 'copy the page into the Windows clipboard
Set docSingle = Documents.Add 'create a new document
docSingle.Range.Paste 'paste the clipboard contents to the new document
'remove any manual page break to prevent a second blank
docSingle.Range.Find.Execute Findtext:="^m", ReplaceWith:=""
'build a new sequentially-numbered file name based on the original multi-paged file name and path
strNewFileName = Replace(docMultiple.FullName, ".doc", "_" & Right$("000" & iCurrentPage, 4) & ".doc")
docSingle.SaveAs strNewFileName 'save the new single-paged document
iCurrentPage = iCurrentPage + 2 'move to the next page
docSingle.Close 'close the new document
rngPage.Collapse wdCollapseEnd 'go to the next page
Loop 'go to the top of the do loop
Application.ScreenUpdating = True 'restore the screen updating
'Destroy the objects.
Set docMultiple = Nothing
Set docSingle = Nothing
Set rngPage = Nothing
End Su

мне как Я понял нужно поправить вот эту строчку

Код:

strNewFileName = Replace(docMultiple.FullName, ".doc", "_" & Right$("000" & iCurrentPage, 4) & ".doc")

[Iska]

mcintosh55, хотите расскажу — как? Вы готовите:

• образец основного файла слияния в документе Microsoft Word (для меня — в старом формате .doc, а не в новом .docx);
• образец списка в Рабочей книге Microsoft Excel (для меня — в старом формате .xls, а не в новом .xlsx), помечаете в нём, скажем, цветом, что должно использоваться в качестве имён конечных файлов;
• проверяете, правильно ли работает слияние;
• упаковываете документ основного файла слияния и рабочую книгу со списком в архив;
• выкладываете архив на общедоступный ресурс, поддерживающий загрузку без ожидания и рекламы, сюда помещаете ссылку.

Если затем возникнут сопутствующие вопросы — Вам их зададут.

Я понял нужно поправить вот эту строчку »

«Эту строчку», скорее всего, уже поздно править. Можно, конечно, озадачиться этим:

мы даже можем узнать эти имена в момент сохранения отдельных частей (если они добавляются куда-либо в текст документа при слиянии, и мы знаем, куда именно) »

но удобнее начать раньше.

[mcintosh55]

ссылка на архив

[Iska]

mcintosh55, давайте попробуем проверить работоспособность подхода в его самом первом приближении.

Для начала Вам нужно удалить все ранее заполненные строки, ныне очищенные, но тем не менее значимые строки из Рабочей книги base.xls. Откройте эту Рабочую книгу, выделите какую-нибудь ячейку на первом листе Лист1, нажмите Ctrl-End. Видите, какая ячейка стала текущей? Все эти строки, пусть и видимо пустые, надо будет удалить. Выделите строки с 4 по 130 (чтоб с запасом) и удалите их. Их следует именно удалить, а не очистить их содержимое! В принципе, свойство .SuppressBlankLines должно бы было позволять игнорировать такие строки, но, похоже, оно работает несколько иначе, нежели мне предполагалось, увы.

Затем попробуйте исполнить следующий код, сохранив его в файле с расширением .wsf и заменив в нём все пути на Ваши:

Скрытый текст

Код:

<job>
	<object ProgId = "Word.Application" id = "objWord" events = "true" />
	<script language = "VBScript">
		Option Explicit
		
		Const wdFormLetters = 0
		Const wdSendToNewDocument = 0
		
		Const wdDefaultFirstRecord = 1
		Const wdDefaultLastRecord  = -16
		
		Const wdNextRecord = -2
		
		Dim objDocument
		Dim objCurrResultDocument
		
		Dim i
		Dim strDocumentName
		
		
		objWord.Visible = True
		
		Set objDocument = objWord.Documents.Open("C:\Мои проекты\0136\order.doc", , True)
		
		With objDocument.MailMerge
			.MainDocumentType = wdFormLetters
			.OpenDataSource _
				"C:\Мои проекты\0136\base.xls", _
				,,,,,,,,,, _
				"Provider=Microsoft.Jet.OLEDB.4.0;Mode=Read;Extended Properties=""HDR=YES;IMEX=1;Jet OLEDB:Engine Type=35;""", _
				"SELECT * FROM `Лист1$`"
			
			.Destination = wdSendToNewDocument
			.SuppressBlankLines = True
			
			For i = wdDefaultFirstRecord To .DataSource.RecordCount
				.DataSource.FirstRecord = .DataSource.ActiveRecord
				.DataSource.LastRecord = .DataSource.ActiveRecord
				
				Set objCurrResultDocument = Nothing
				
				strDocumentName = .DataSource.DataFields.Item("SNP").Value
				
				.Execute False
				.DataSource.ActiveRecord = wdNextRecord
				
				Do
					WScript.Sleep 100
				Loop Until Not objCurrResultDocument Is Nothing
				
				objCurrResultDocument.Close
			Next
		End With
		
		objDocument.Close False
		WScript.DisconnectObject objWord
		objWord.Quit
		
		WScript.Quit 0
		
		Sub objWord_MailMergeAfterMerge(ByVal objResultDocument, ByVal objMainDocument)
			objResultDocument.SaveAs "C:\Мои проекты\0136\" & strDocumentName & ".doc"
			Set objCurrResultDocument = objResultDocument
			
			WScript.Echo "Mail Merge Complete: " & objResultDocument.FullName
		End Sub
	</script>
</job>

Я здесь не делал пока никаких проверок, только проверил работоспособность. У меня результатом было создание двух файлов:

Код:

Иванов Иван Иванович.doc
Петров Петр Петрович.doc

[mcintosh55]

office 2013 /2016, скрипт ругается на 5 строчку: Методы или свойство OpenDataSource недоступны, потому что эту команду нельзя использовать в режиме чтения. И действительно word запускаться в режиме чтения

Защищенный просмотр все галки сняты