[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