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

[jordan_74]

Приветствую уважаемые форумчане!!!!!
Очень нужна помощь!!! нужно реализовать возможность запуска программы с любого компьютера в сети. Тоесть без привязки к конкретным путям.


Option Explicit

Const xlCSV = 6
Const xlWindows = 2


Dim strTemplateFile
Dim strSourceFile
Dim strDestFolder


Dim objFSO
Dim objExcel

Dim objTemplateFile
Dim objSourceFile

Dim i
Dim strDestFile

Dim anyValue


strTemplateFile = "C:\РЕЕСТР ЧЕКОВ\Шаблон\check.csv"
strDestFolder = "C:\РЕЕСТР ЧЕКОВ\Итог"

If WScript.Arguments.Count = 1 Then
strSourceFile = WScript.Arguments.Item(0)

Set objFSO = WScript.CreateObject("Scripting.FileSystemObject")

If objFSO.FileExists(strTemplateFile) Then
If objFSO.FileExists(strSourceFile) Then
If objFSO.FolderExists(strDestFolder) Then
Set objExcel = WScript.CreateObject("Excel.Application")

objExcel.Workbooks.OpenText strTemplateFile, , , , , , , , , , , , , , , , , True
Set objTemplateFile = objExcel.Workbooks.Item(1)

Set objSourceFile = objExcel.Workbooks.Open(strSourceFile, 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, 1)
End With

strDestFile = objFSO.BuildPath(strDestFolder, objFSO.GetBaseName(strTemplateFile) & "_" & objFSO.GetBaseName(strSourceFile) & "_" & 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

objExcel.Quit
Set objExcel = Nothing
Else
WScript.Echo "Can't find destination folder [" & strDestFolder & "]."
WScript.Quit 4
End If
Else
WScript.Echo "Can't find source file [" & strSourceFile & "]."
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 file>"
WScript.Quit 1
End If

WScript.Quit 0

[Iska]

jordan_74, я могу лишь повторить свой вопрос — как Вы это видите?

[jordan_74]

Iska, Файл скрипта и шаблон чека находятся в отдельных папка в сети.
У пользователя папка с файлом реестра и папка с целевыми файлами чеков, а также исполнительный файл, который запускает процесс преобразования.

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

Как конкретно это реализовать откровенно говоря не знаю (

[Iska]

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

[jordan_74]

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

[Iska]

Нужно располагать относительно »
И как именно?

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

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

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

как и папку с файлом реестра »
А это как?!

[jordan_74]

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

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

[Iska]

Попробуйте так:
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. Целевой каталог, если таковой не существует, будет создан.

[jordan_74]

Iska,
Работает! Спасибо!
Хотел вот ещё что уточнить, сейчас скрипт округляет сумму до двух знаков после запятой.
Используется функция round. Но я так понял, что это обычное бухгалтерское округление тоесть Round(2,5) = 2
У меня если сумма будет 2,569 то округление должно происходить в большую сторону, тоесть 2, 57

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

[jordan_74]

Вот пример:

Public Function MatRound#(v#, n&)
'v - округляемое число;
'n - разряд, до которого выполняется округление:
' ...
' -2 - до сотен;
' -1 - до десятков;
' 0 - до единиц (до целых);
' 1 - до десятых;
' 2 - до сотых;
' ...
MatRound = Format(v * 10 ^ n, "0") / 10 ^ n
End Function

[Iska]

Но я так понял, что это обычное бухгалтерское округление тоесть Round(2,5) = 2 »
Да, это т.н. банковское округление, или округление к ближайшему чётному:
The Round function performs round to even, which is different from round to larger. The return value is the number closest to the value of expression, with the appropriate number of decimal places. If expression is exactly halfway between two possible rounded values, the function returns the possible rounded value whose rightmost digit is an even number. (In a round to larger function, a number that is halfway between two possible rounded values is always rounded to the larger number.)

Round to even is a statistically more accurate rounding algorithm than round to larger.

[jordan_74]

Iska, А можно сделать обычное округление, когда после запятой стоит 5 и выше, округлять в большую сторону, а если меньше 5 то в меньшую?

[Iska]

Попробуйте так (не проверялось):
.Range("L3").Value = Fix((anyValue * 18 / 118 + 0.005) * 100) / 100

[jordan_74]

Iska, Добрый день!
не могу проверить к сожалению, повторяется одна и та же ошибка.
http://forum.oszone.net/attachment.php?attachmentid=154884&stc=1&d=1541579064

Запускаю с рабочего стола, перетаскивая папку с файлами реестра на ярлык скрипта. Сам скрипт и файл шаблона в папке на диске C:

Код вот такой:

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 = "C:\Реестр\Шаблон\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 = Fix((anyValue * 18 / 118 + 0.005) * 100) / 100
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

[Iska]

Проверьте кодировку, в которой сохранён файл скрипта. Она должна быть ANSI/1251.

[jordan_74]

Проверьте кодировку, в которой сохранён файл скрипта. Она должна быть ANSI/1251. »
Сработало! Хотя до этого никаких манипуляций с кодировкой не делал, и отрабатывало

[q=Iska] у меня огромная просьба встроить в скрипт логирование. Видел варианты, в которых создается лог в случае ошибки. Мне полагается тут нечему ломаться. Нашел вот такой вариант:

Const ForAppending = 8
Dim strLogFile, strDate

strDate = Date
strLogFile = "Logs\Find_Primary_" & Year(strDate) & Month(strDate) & Day(strDate) & ".log"

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objLogFile = objFSO.OpenTextFile(strLogFile, ForAppending, True)


objLogfile.WriteLine "Testing my new log file"
objLogFile.Close


Есть вариант как создается за бугром у ребят) https://community.spiceworks.com/scripts/show/2359-add-logging-to-a-vbscript

[Iska]

jordan_74, это всё замечательно. Но какой в этом смысл в данном-то случае?

[jordan_74]

Iska,
Способ контроля.Например

Кол-во обработанных строк должно равняться кол-ву созданных чеков;
Сумма по реестру должна равняться сумме всех сумм в чеках данного реестра )

Чтобы если что то потерялось, мы могли понимать сколько было изначально чеков.
Ну и чтобы итоговая сумма совпадала, или расхождения были минимальные.

[Iska]

Кол-во обработанных строк должно равняться кол-ву созданных чеков; »
Что тут можно контролировать, если по другому и быть не может:
For i = 1 To objSourceFile.Worksheets.Item(1).UsedRange.Rows.Count - 2
…
objTemplateFile.SaveAs strDestFile, xlCSV, , , , , , , , , , True
Next

?! Не вижу в этом никакого смысла.

Сумма по реестру должна равняться сумме всех сумм в чеках данного реестра ) »
Честно сказать, мне это ни о чём не говорит :).

Чтобы если что то потерялось, »
Количество строк (за вычетом двух) всегда будет совпадать с количеством сгенерированных файлов.

Ну и чтобы итоговая сумма совпадала, или расхождения были минимальные. »
Поясните подробнее.

[jordan_74]

Что тут можно контролировать, если по другому и быть не может:
Код:
For i = 1 To objSourceFile.Worksheets.Item(1).UsedRange.Rows.Count - 2
…
objTemplateFile.SaveAs strDestFile, xlCSV, , , , , , , , , , True
Next
?! Не вижу в этом никакого смысла. »
Это для информации, которая должна быть понятна простому бухгалтеру. Столько то строк реестра отработано-получилось столько то чеков.

Сумма по реестру должна равняться сумме всех сумм в чеках данного реестра ) »
Честно сказать, мне это ни о чём не говорит . »

В файле реестра мы откидываем 2 строки; название столбцов и итоговую сумму по реестру. В каждой "рабочей" строке есть поле сумма, значение которого и копируется в шаблон чека.
Допустим в реестре 40 рабочих строк и общая сумма будет 1600, то при складывании сумм(ячейка H3) в 40 созданных чеках, должно быть тоже 1600 =)

Цитата jordan_74:
Ну и чтобы итоговая сумма совпадала, или расхождения были минимальные. » »

Это тоже самое, что я описал выше