Имя пользователя:
Пароль:  
Помощь | Регистрация | Забыли пароль?  

Показать сообщение отдельно

Ветеран


Сообщения: 27449
Благодарности: 8086

Профиль | Отправить PM | Цитировать


Попробуйте так:
Скрытый текст
Код: Выделить весь код
Option Explicit

Const xlCSV = 6
Const xlWindows = 2


Dim strSourceFolder

Dim strTemplateFile

Dim strRelativeDestFolder
Dim strDestFolder

Dim objFSO
Dim objExcel

Dim objFile

Dim objTemplateFile
Dim objSourceFile

Dim i
Dim strDestFile

Dim anyValue


strTemplateFile       = "\\Server01\Share01\Шаблон\check.csv"
strRelativeDestFolder = "..\Итог"

If WScript.Arguments.Count = 1 Then
	strSourceFolder = WScript.Arguments.Item(0)
	
	Set objFSO = WScript.CreateObject("Scripting.FileSystemObject")
	
	If objFSO.FileExists(strTemplateFile) Then
		If objFSO.FolderExists(strSourceFolder) Then
			strDestFolder = objFSO.GetAbsolutePathName(objFSO.BuildPath(strSourceFolder, strRelativeDestFolder))
			
			If Not objFSO.FolderExists(strDestFolder) Then
				objFSO.CreateFolder strDestFolder
			End If
			
			Set objExcel = Nothing
			
			For Each objFile In objFSO.GetFolder(strSourceFolder).Files
				Select Case LCase(objFSO.GetExtensionName(objFile.Name))
					Case "xls", "xlsx"
						If objExcel Is Nothing Then
							Set objExcel = WScript.CreateObject("Excel.Application")
						End If
						
						objExcel.Workbooks.OpenText strTemplateFile, , , , , , , , , , , , , , , , , True
						Set objTemplateFile = objExcel.Workbooks.Item(1)
						
						Set objSourceFile = objExcel.Workbooks.Open(objFile.Path, False, True)
						
						For i = 1 To objSourceFile.Worksheets.Item(1).UsedRange.Rows.Count - 2
							With objTemplateFile.Worksheets.Item(1)
								anyValue = objSourceFile.Worksheets.Item(1).Cells.Item(i + 1, 5).Value
								
								.Range("B3").Value = anyValue
								.Range("F2").Value = anyValue
								
								anyValue = objSourceFile.Worksheets.Item(1).Cells.Item(i + 1, 6).Value
								
								.Range("D3").Value = anyValue
								.Range("D4").Value = anyValue
								.Range("H3").Value = anyValue
								
								.Range("L3").Value = Round((anyValue * 18) / 118, 2)
							End With
							
							strDestFile = objFSO.BuildPath(strDestFolder, objFSO.GetBaseName(strTemplateFile) & "_" & objFSO.GetBaseName(objFile.Name) & "_" & Right("000" & CStr(i), 3) & "." & objFSO.GetExtensionName(strTemplateFile))
							
							If objFSO.FileExists(strDestFile) Then
								objFSO.DeleteFile strDestFile, True
							End If
							
							objTemplateFile.SaveAs strDestFile, xlCSV, , , , , , , , , , True
						Next
						
						objSourceFile.Close False
						objTemplateFile.Close False
				End Select
			Next
			
			If Not objExcel Is Nothing Then
				objExcel.Quit
				Set objExcel = Nothing
			End If
		Else
			WScript.Echo "Can't find source folder [" & strSourceFolder & "]."
			WScript.Quit 3
		End If
	Else
		WScript.Echo "Can't find template file [" & strTemplateFile & "]."
		WScript.Quit 2
	End If
	
	Set objFSO = Nothing
Else
	WScript.Echo "Usage: cscript.exe //nologo """ & WScript.ScriptName & """ <Source folder>"
	WScript.Quit 1
End If

WScript.Quit 0

Теперь пусть перетаскивают на скрипт (или на ярлык на скрипт) исходную папку с файлами реестра. Ваш путь к файлу с шаблоном чека укажите в переменной strTemplateFile. Целевой каталог, если таковой не существует, будет создан.
Это сообщение посчитали полезным следующие участники:

Отправлено: 22:59, 30-10-2018 | #48