[Iska]

На WSH, пробуйте:

читать дальше »

Код:

Option Explicit

Dim strSourceFolder

Dim objFile
Dim arrContent

Dim objExcel
Dim objWorkbook
Dim objWorksheet
Dim objRange
Dim i

If WScript.Arguments.Count = 1 Then
	strSourceFolder = WScript.Arguments.Item(0)
	
	With WScript.CreateObject("Scripting.FileSystemObject")
		If .FolderExists(strSourceFolder) Then
			Set objExcel = Nothing
			
			For Each objFile In .GetFolder(strSourceFolder).Files
				If LCase(.GetExtensionName(objFile.Name)) = "txt" Then
					If objExcel Is Nothing Then
						Set objExcel     = WScript.CreateObject("Excel.Application")
						Set objWorkbook  = objExcel.Workbooks.Add()
						Set objWorksheet = objWorkbook.Worksheets.Item(1)
						Set objRange     = objWorksheet.Range("C3")
					End If
					
					
					With .OpenTextFile(objFile.Path)
						arrContent = Split(.ReadAll(), vbCrLf)
						.Close
					End With
					
					objRange.Value = .GetBaseName(objFile.Name)
					objRange.Font.Bold = True
					
					For i= LBound(arrContent) To UBound(arrContent) - 1
						objRange.Offset(i + 1, 0).Value = Split(arrContent(i), vbTab)(1)
					Next
					
					Set objRange = objRange.Offset(0, 1)
				End If
			Next
			
			If Not objExcel Is Nothing Then
				Set objRange     = Nothing
				Set objWorksheet = Nothing
				
				objWorkbook.SaveAs .BuildPath(strSourceFolder, "Result.xls")
				Set objWorkbook  = Nothing
				
				objExcel.Quit
				Set objExcel     = Nothing
			End If
		Else
			WScript.Echo "Can't find source folder [" & strSourceFolder & "]."
			WScript.Quit 2
		End If
	End With
Else
	WScript.Echo "Usage: cscript.exe //nologo " & WScript.ScriptName & " <Source folder>"
	WScript.Quit 1
End If

WScript.Quit 0

Можно просто перетащить папку с искомыми файлами на скрипт.

[Streamnewal]

Спасибо. Буду пробовать.