VBA - Разбивка строк общего файла на отдельные csv файлы

[Iska]

Iska,

Скрипт, шаблон и батник, который запускает скрипт будут лежать где то в сети.



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



У пользователя будет 2 папки - Реестр и Итог, и тот самый батник.



Как это можно осуществить? ) Я полагаю это можно сделать как то с помощью передачи параметров.

В качестве параметров видимо должны быть пути к папке с файлом(ами) реестра, и к папке Итог

[Iska]

Отнюдь. У нас три составляющих:путь к файлу шаблона;путь к целевому каталогу;путь к исходным файлам.В нашем коде мы жёстко указывали путь к файлу шаблона и путь к целевому каталогу. Путь к исходным файлам задавался параметром.



Ваши предложения?

[Iska]

Iska,



Откровенно говоря предложений пока нет.



Можно попытаться использовать команду "psexec" для запуска батника(а затем и скрипта по сети)



//что то в духе



@echo off

psexec \\IP или имя компа\Documents and Settings\User\kill.cmd

exit

[Iska]

Цитата jordan_74:



и папка с целевыми файлами чеков

VBA - Разбивка строк общего файла на отдельные csv файлы

Путь к ней будет одинаков для любых пользователей на любых машинах? Или же мы будем её располагать относительно:


Цитата jordan_74:



папка с файлом реестра

VBA - Разбивка строк общего файла на отдельные csv файлы

?

[Iska]

Цитата Iska:



Путь к ней будет одинаков для любых пользователей на любых машинах? Или же мы будем её располагать относительно:

VBA - Разбивка строк общего файла на отдельные csv файлы

Нужно располагать относительно, как и папку с файлом реестра

[Iska]

Цитата jordan_74:



Нужно располагать относительно

VBA - Разбивка строк общего файла на отдельные csv файлы

И как именно?



Например, каталог с файлами реестра располагается в «C:\Мои проекты\0191\Архив\Архив\Реестр». Тогда скрипт будет предполагать наличие каталога для целевых файлов рядом с каталогом с файлами реестра, т.е, относительно каталога с файлами реестра — как «..\Итог», что в данном конкретном случае отобразится на каталог «C:\Мои проекты\0191\Архив\Архив\Итог».



Или же: «C:\Моя папка\Мой Реестр» и, соответственно — «C:\Моя папка\Итог».



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




Цитата jordan_74:



как и папку с файлом реестра

VBA - Разбивка строк общего файла на отдельные csv файлы

А это как?!

[jordan_74]

Цитата Iska:



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

VBA - Разбивка строк общего файла на отдельные csv файлы

Здесь полностью согласен.



Я имел ввиду что каталог с целевыми файлами предполагает наличие рядом каталога с файлами реестра, именно так

[Iska]

Попробуйте так:



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

[spoiler]Код:

[/spoiler]

Код: Выделить всё

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 & """ "
	WScript.Quit 1
End If
WScript.Quit 0

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

[jordan_74]

Iska,

Работает! Спасибо!

Хотел вот ещё что уточнить, сейчас скрипт округляет сумму до двух знаков после запятой.

Используется функция round. Но я так понял, что это обычное бухгалтерское округление тоесть Round(2,5) = 2

У меня если сумма будет 2,569 то округление должно происходить в большую сторону, тоесть 2, 57



Читал про функцию MRound, но не уверен, что тут она подойдёт

[Iska]

Попробуйте так:



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

[spoiler]Код:

[/spoiler]

Код: Выделить всё

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 & """ "
	WScript.Quit 1
End If
WScript.Quit 0

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