Разбивка строк общего файла на отдельные csv файлы
Добрый день всем!! Нужна помощь с написанием макроса.
Имеется 3 папки Шаблон, Реестр и Итог В папке Реестр лежит исходный файл excel с данными. В папке шаблон лежит файл с именем check формата csv, который планируется использовать в качестве шаблона. Нужен макрос, который бы открывал исходный файл, копировал данные в файл шаблона.csv и сохранял этот файл шаблона в папку "Итог" с именем сheck1. Каждая строка исходного файла = один файл check. То есть если в исходном файле условно 50 строк, то должно получиться 49 чеков(в последнюю строку исходного файла выводится общая сумма, она не нужна) Имена файлов в папке итог должны быть от check1 до условно check49 Данные для копирования: E2(исх) в B3(шаблон); E2(исх) в F2(шаблон); F2(исх) в D3,D4,H3(шаблон) В файле шаблона check ячейка L3 должна рассчитываться по формуле (F2(исх)*18)/118 F2, E2 это ячейки первой строки с данными, т.к выше только заголовки столбцов. То есть когда цикл пробегает по следующей строчке, будет уже не F2, E2 а F3, E3 и т.д Надеюсь понятно объяснил) С VBA знаком крайне поверхностно. Нашел на форуме лишь решение по копированию файлов. Sub DirCopy() Dim OldPath$, NewPath$, Shablon$, OnlyName$ OldPath = "C:\proba\zvit\" NewPath = "C:\proba\Temp\" Shablon = "*.*" OnlyName = Dir(OldPath & Shablon, vbReadOnly + vbHidden + vbSystem) Do Until OnlyName = "" FileCopy OldPath & OnlyName, NewPath & OnlyName OnlyName = Dir Loop End Sub |
Цитата:
Цитата:
|
Вложений: 1
Iska,
Архив с примерами файлов приложил |
Цитата:
|
|
Цитата:
Цитата:
|
Вложений: 1
|
jordan_74, в примере Вашего файла присутствует явное округление — 152,5 вместо 152,5423729. Что Вы можете пояснить по этому поводу?
Макрос VBA: Скрытый текст
Код:
Option Explicit На WSH: Скрытый текст
Код:
Option Explicit |
Iska,так и есть, один знак после запятой, таков формат данных в ячейке
|
Все работает как надо.
Цитата:
Тогда возникнет путаница с нумерацией чеков.... Возможно к имени чека помимо нумерации нужно добавлять имя файла реестра, что то типа check_26.08.2018_38490,25_001 |
Цитата:
Цитата:
|
jordan_74, примерно так (на WSH):
Скрытый текст
Код:
Option Explicit пробуйте. Путь к файлу шаблона и целевой папке задаётся жёстко в скрипте, путь к исходному файлу указывается аргументом скрипта (также можно просто перетянуть исходный файл на скрипт в Проводнике). |
Цитата:
|
Цитата:
P.S. Забыл самое главное — одноимённые файлы, уже существующие в целевом каталоге, будут молча перезаписаны (точнее — удалены, а на их место будут записаны новые файлы). |
Вложений: 1
Iska,
Скопировал код, сохранил в формате .js но при запуске возникла ошибка, может я что то криво сделал Скрытый текст
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 |
Цитата:
|
Вложений: 1
Iska,
Сохранил в формате .vbs Отработало как надо. Вопрос, нужно именно перетаскивать файл реестра на скрипт, или все таки можно сделать обычным двойным кликом? |
|
Цитата:
Тем не менее огромное спасибо Iska, вы очень помогли и облегчили работу многим людям. У меня финальная просьба, т.к я с wsh вообще не знаком, могли бы прокомментировать блоки кода, чтобы понять что делается на разных этапах..!? |
Цитата:
|
Цитата:
1. Тупо указать в коде. Это был наш первый вариант (и наихудший). 2. Указать аргументом скрипта. Это наш второй вариант (и наиболее предпочтительный). Вы, например, можете просто перетаскивать исходный файл реестра на скрипт, я — могу быстро и удобно, посредством всего нескольких нажатий клавиш, указывать путь к исходному файлу реестра в командной строке Far Manager'а: Скрытый текст
кто-то напишет пакетный файл, в котором будут перебираться только заданные файлы реестра: Скрытый текст
Код:
@echo off или все подряд файлы реестра в каталоге, наподобие: Скрытый текст
Код:
@echo off И всё это будет работать. 3. Хранить путь в каком-либо заранее предопределённом и обговоренном месте. Например, использовать какой-нибудь файл конфигурации с предопределённым именем и местоположением, в котором указывать путь к исходному файлу (откуда он будет считываться скриптом). Или какой-нибудь предопределённый параметр в реестре. Столь же неудобно и малоосмысленно, как и прямое указание пути непосредственно в коде. Цитата:
Цитата:
Скрытый текст
Код:
Option Explicit |
Iska,
Вечер добрый!!!! А можно пакетным файлом запускать скрипт, чтобы он все файлы реестра обрабатывал, которые лежат в папке "Реестр" ? Пробовал этот код, не получилось) Скрытый текст
@echo off setlocal enableextensions enabledelayedexpansion for %%i in ("C:\Мои проекты\0191\Архив\Архив\Реестр\*.xlsx") do ( echo [%%~i] cscript.exe //nologo "C:\Мои проекты\0191\Архив\Архив\0001.vbs" "%%~i" ) endlocal exit /b 0 |
jordan_74, а пути:
Код:
@echo off |
Iska, у меня вот такой код с моими путями.
Скрипт назвал checkCut.vbs Скрытый текст
@echo off setlocal enableextensions enabledelayedexpansion for %%i in ("C:\РЕЕСТР ЧЕКОВ\реестр\*.xlsx") do ( echo [%%~i] cscript.exe //nologo "C:\РЕЕСТР ЧЕКОВ\checkCut.vbs" "%%~i" ) endlocal exit /b 0 |
jordan_74, и…? Если открыть командную строку и запустить в ней этот пакетный файл, что происходит?
|
Iska,
Я батник двойным кликом запускаю. Ошибка вот такая же cscript.exe //nologo "C:\РЕЕСТР ЧЕКОВ\checkCut.vbs" "%%~i" |
Цитата:
Скрытый текст
нажмите Enter, покажите, что получилось. |
Iska,
Так все работает да! Спасибо! А я спросил потому, что хочется как в лучших домах, "нажал кнопочку" и готово, чтобы как можно меньше кликов делать) Я думал, что можно запустить батник, и уже он запускает в работу скрипт, который отработает все файлы реестров в папке. |
jordan_74, не должно быть никакой разницы между запуском в командной строке или обычным двойным щелчком. Разве что Вы какие-то коррективы вносили в насройки исполнения пакетных файлов.
Давайте попробуем так — закомментировать @echo off и добавить в конец паузу: Код:
rem @echo off |
Вложений: 1
Iska,
Вот что получилось |
jordan_74, замечательно. Убирайте комментарий с первой строки и паузу в конце.
Пакетный файл требуется сохранять в кодировке OEM/866. У Вас это не так, посему и не находится ни единого файла. А меня ещё здесь шпыняют, |
Iska,
:lol: мне остается посмеяться только над самим собой Все работает, обычная невнимательность с моей стороны была причиной всему. Ещё раз огромное спасибо!!!!!! |
jordan_74, ничего страшного, бывает. А вот мне следовало бы зараз догадаться о причинах :(.
|
Iska,
Добрый день! Я прошу прощения, понадобилось всё таки сделать кол-во знаком после запятой не 1 а 2 Много перерабатывать, где корректировки внести подскажите пожалуйста? |
Цитата:
Код:
.Range("L3").Value = Round((anyValue * 18) / 118, 2) |
Iska,
Да я уже поправил, спасибо. И теперь встал наверно главный вопрос. Нужно чтобы скрипт отрабатывал, при этом батник запускающий скрипт и скрипт лежали где то в другом месте, не на компе пользователя Передавать параметры. Все для того, чтобы при переносе на другой комп, не приходилось постоянно менять пути в скрипте и батнике. |
jordan_74, поясните более подробно, что Вы имеете в виду.
|
Iska,
Скрипт, шаблон и батник, который запускает скрипт будут лежать где то в сети. Пользователь на своём компе будет запускать батник, который активирует(запускает) батник - который запускает в работу скрипт. )) я прошу прощения за такую тавтологию. У пользователя будет 2 папки - Реестр и Итог, и тот самый батник. Как это можно осуществить? ) Я полагаю это можно сделать как то с помощью передачи параметров. В качестве параметров видимо должны быть пути к папке с файлом(ами) реестра, и к папке Итог |
Отнюдь. У нас три составляющих:
Ваши предложения? |
Iska,
Откровенно говоря предложений пока нет. Можно попытаться использовать команду "psexec" для запуска батника(а затем и скрипта по сети) //что то в духе @echo off psexec \\IP или имя компа\Documents and Settings\User\kill.cmd exit |
Приветствую уважаемые форумчане!!!!!
Очень нужна помощь!!! нужно реализовать возможность запуска программы с любого компьютера в сети. Тоесть без привязки к конкретным путям. Скрытый текст
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 |
jordan_74, я могу лишь повторить свой вопрос — как Вы это видите?
|
Iska, Файл скрипта и шаблон чека находятся в отдельных папка в сети.
У пользователя папка с файлом реестра и папка с целевыми файлами чеков, а также исполнительный файл, который запускает процесс преобразования. Пользователь запускает условно батник, который запускает в работу скрипт, лежащий в сети. Скрипт обрабатывает файл реестра и складывает готовые файлы чека в итоговую папку. Как конкретно это реализовать откровенно говоря не знаю ( |
|
Цитата:
|
Цитата:
Например, каталог с файлами реестра располагается в «C:\Мои проекты\0191\Архив\Архив\Реестр». Тогда скрипт будет предполагать наличие каталога для целевых файлов рядом с каталогом с файлами реестра, т.е, относительно каталога с файлами реестра — как «..\Итог», что в данном конкретном случае отобразится на каталог «C:\Мои проекты\0191\Архив\Архив\Итог». Или же: «C:\Моя папка\Мой Реестр» и, соответственно — «C:\Моя папка\Итог». Скрипт даже может сам создавать каталог для целевых файлов, буде таковое потребно. Цитата:
|
Цитата:
Я имел ввиду что каталог с целевыми файлами предполагает наличие рядом каталога с файлами реестра, именно так |
Попробуйте так:
Скрытый текст
Код:
Option Explicit Теперь пусть перетаскивают на скрипт (или на ярлык на скрипт) исходную папку с файлами реестра. Ваш путь к файлу с шаблоном чека укажите в переменной strTemplateFile. Целевой каталог, если таковой не существует, будет создан. |
Iska,
Работает! Спасибо! Хотел вот ещё что уточнить, сейчас скрипт округляет сумму до двух знаков после запятой. Используется функция round. Но я так понял, что это обычное бухгалтерское округление тоесть Round(2,5) = 2 У меня если сумма будет 2,569 то округление должно происходить в большую сторону, тоесть 2, 57 Читал про функцию MRound, но не уверен, что тут она подойдёт |
Вот пример:
Public Function MatRound#(v#, n&) 'v - округляемое число; 'n - разряд, до которого выполняется округление: ' ... ' -2 - до сотен; ' -1 - до десятков; ' 0 - до единиц (до целых); ' 1 - до десятых; ' 2 - до сотых; ' ... MatRound = Format(v * 10 ^ n, "0") / 10 ^ n End Function |
Цитата:
Цитата:
|
Iska, А можно сделать обычное округление, когда после запятой стоит 5 и выше, округлять в большую сторону, а если меньше 5 то в меньшую?
|
Попробуйте так (не проверялось):
Код:
.Range("L3").Value = Fix((anyValue * 18 / 118 + 0.005) * 100) / 100 |
Вложений: 1
Iska, Добрый день!
не могу проверить к сожалению, повторяется одна и та же ошибка. http://forum.oszone.net/attachment.p...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 |
Проверьте кодировку, в которой сохранён файл скрипта. Она должна быть 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/scr...-to-a-vbscript |
jordan_74, это всё замечательно. Но какой в этом смысл в данном-то случае?
|
Iska,
Способ контроля.Например Кол-во обработанных строк должно равняться кол-ву созданных чеков; Сумма по реестру должна равняться сумме всех сумм в чеках данного реестра ) Чтобы если что то потерялось, мы могли понимать сколько было изначально чеков. Ну и чтобы итоговая сумма совпадала, или расхождения были минимальные. |
Цитата:
Код:
For i = 1 To objSourceFile.Worksheets.Item(1).UsedRange.Rows.Count - 2 Цитата:
Цитата:
Цитата:
|
Цитата:
Цитата:
Допустим в реестре 40 рабочих строк и общая сумма будет 1600, то при складывании сумм(ячейка H3) в 40 созданных чеках, должно быть тоже 1600 =) Цитата:
|
Цитата:
Код:
objTemplateFile.SaveAs strDestFile, xlCSV, , , , , , , , , , True Цитата:
|
Цитата:
Можно ли сделать, чтобы данные записывались в лог файл в формате txt* ? |
|
Iska,
хорошо |
Iska, День добрый! С логированием разобрался, с горем пополам.
Хочу сделать проверку, в ситуации когда папка с файлами реестра пуста, чтобы выводилось сообщение об этом. Просьба подсказать где ошибка.. у меня выводится сообщение что реестров нет (папка пуста) при любых случаях, даже если файлы там есть. Скрытый текст
Option Explicit Const xlCSV = 6 Const xlWindows = 2 Dim Log 'Лог-файл Dim strSourceFolder Dim strSourceFile Dim strTemplateFile Dim strRelativeDestFolder Dim strDestFolder Dim strLogDestFolder 'Папка, в которой будут создаваться лог-файлы Dim objFSO Dim objExcel Dim objFolder Dim colFiles Dim objFile Dim objTemplateFile Dim objSourceFile Dim i Dim strDestFile Dim strLogDestFile Dim SumSourceFile 'Сумма по реестру Dim SumDestFile 'Сумма по чекам Dim SumTotal 'Общая сумма Dim CountSourceFiles 'Для подсчета файлов реестра CountSourceFiles = 0 Dim anyValue 'Здесь указать полный адрес папки с файлами реестра: strSourceFolder = "C:\Реестр\Реестр" strTemplateFile = "C:\Реестр\Шаблон\check.csv" strRelativeDestFolder = "..\Итог" strLogDestFolder = "C:\Касса" '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 If objFSO.FileExists(objSourceFile) Then strDestFolder = objFSO.GetAbsolutePathName(objFSO.BuildPath(strSourceFolder, strRelativeDestFolder)) If Not objFSO.FolderExists(strDestFolder) Then objFSO.CreateFolder strDestFolder End If 'Создание папки Касса: If Not objFSO.FolderExists(strLogDestFolder) Then objFSO.CreateFolder strLogDestFolder End If Set objExcel = Nothing For Each objFile In objFSO.GetFolder(strSourceFolder).Files 'Подсчет количества файлов реестра: CountSourceFiles = CountSourceFiles + 1 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 'Подсчет общей суммы: SumTotal = SumTotal + anyValue 'Подсчет суммы по реестру: SumSourceFile = SumSourceFile + anyValue 'Подсчет суммы по чекам: SumDestFile = SumDestFile + .Range("H3").Value 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 'В strLogDestFile записывается где будет создан лог-файл и как он будет называться: strLogDestFile = objFSO.BuildPath(strLogDestFolder, Day(now) & "_" & Month(now) & "_" & Year(now) & ".txt") 'Открытие лог-файла или создание, если его нет: Set Log = objFSO.OpenTextFile(strLogDestFile, 8, True) 'Запись данных в лог-файл: Log.Write FormatDateTime(now, 0) 'В лог записывается дата и время обработки файлов Log.Write ". Обработан файл " & objFSO.GetBaseName(objFile.Name) & "." & objFSO.GetExtensionName(objFile.Name) Log.Write ". Строк обработано: " & CStr(objSourceFile.Worksheets.Item(1).UsedRange.Rows.Count - 2) Log.Write ". Чеков создано: " & CStr(objSourceFile.Worksheets.Item(1).UsedRange.Rows.Count - 2) Log.Write ". Сумма по реестру: " & SumSourceFile Log.Write ". Сумма по чекам: " & SumDestFile 'Сравнение сумм по реестру и чекам - если они равны, то это записывается в лог If SumSourceFile = SumDestFile Then Log.Write ". Суммы равны." End If Log.WriteBlankLines(1) Log.Close 'Обнуление сумм, чтобы для каждого файла реестра и его чеков считалась своя отдельная сумма SumSourceFile = 0 SumDestFile = 0 objSourceFile.Close False objTemplateFile.Close False End Select Next If Not objExcel Is Nothing Then objExcel.Quit Set objExcel = Nothing End If ' Очищение папки Реестр Set objFSO = CreateObject("Scripting.FileSystemObject") Set objFolder = objFSO.GetFolder(strSourceFolder) Set colFiles = objFolder.Files For Each objFolder in colFiles objFolder.Delete next 'Выводит окно о завершении обработки файлов: WScript.Echo "Чеки сформированы успешно. Обработано " & CountSourceFiles & " реестра на сумму " & SumTotal & "." Else WScript.Echo "Нет файла реестра [" & strSourceFile & "]." WScript.Quit 3 End if Else WScript.Echo "Can't find source folder [" & strSourceFolder & "]." WScript.Quit 2 End If Set objFSO = Nothing Else WScript.Echo "Can't find template file [" & strTemplateFile & "]." WScript.Quit 1 End If 'Else ' WScript.Echo "Usage: cscript.exe //nologo """ & WScript.ScriptName & """ <Source folder>" ' WScript.Quit 1 'End If WScript.Quit 0 |
Время: 09:38. |
Время: 09:38.
© OSzone.net 2001-