Программа предназначена для скачивания файлов CSV с сайта за указанный диапазон дат.
Скачиваемые CSV файлы содержат почасовые данные о мощности генерации и потребления ОЭС заданного округа.
Исходными данными для программы выступают 2 даты - начальная и конечная.
Для каждой даты макрос формирует ссылку на требуемый файл CSV, и загружает этот файл из интернета в указанную папку.
В ходе загрузки отображается прогресс-бар.
Скорость загрузки файлов зависит от производительности сервера so-ups.ru, и составляет примерно 10 файлов в секунду.
Макрос загрузки файлов вы найдете во вложении к статье.
Создаваемые файлы получают имена типа
04.01.2000.csv
01.01.2000.csv
02.01.2000.csv
03.01.2000.csv
Все скачанные файлы помещаются в подпапку с именем Файлы CSV, автоматически создаваемую макросом в той же папке, где расположен файл Excel с макросом.
Примерный код программы (без прогресс-бара):
Sub Main() ПапкаДляФайлов$ = Replace(ThisWorkbook.FullName, ThisWorkbook.Name, "Файлы CSV\") Dim dat As Date, date1 As Date, date2 As Date date1 = DateSerial(2000, 1, 1) ' стартовая дата date2 = Now - 1 ' конечная дата (вчерашний день) On Error Resume Next: MkDir ПапкаДляФайлов$ ' создаём папку для файлов, если её ещё нет ' шаблон ссылки на загружаемый файл URL_template$ = "http://so-ups.ru/index.php?id=1203&tx_ms1cdu_pi1[dt]=%%%%&tx_ms1cdu_pi1[format]=csv" For dat = date1 To date2 ' перебираем все даты ' формируем ссылку на очередной CSV файл URL$ = Replace(URL_template$, "%%%%", Format(dat, "DD.MM.YYYY")) ' формируем имя сохраняемого файла Filename$ = ПапкаДляФайлов$ & Format(dat, "DD.MM.YYYY") & ".csv" DoEvents If DownLoadFile(URL$, Filename$) Then Debug.Print "Скачан файл: " & Filename$ Else MsgBox "Не удалось загрузить файл за дату " & Format(dat, "DD.MM.YYYY"), vbCritical End If Next dat End Sub
Во втором прикреплённом файле - тот же макрос, плюс функция импорта данных из скачанных файлов CSV на лист Excel.
(из всех файлов CSV в папке загружаются данные в единую таблицу)
Комментарии
Выдает ошибку Run time error 9, subscript out of range.
несколько CSV c разделителями, 11 столбцов, лежат в папке, скачивать с сайта не нужно.
ВИдимо что-то нужно сделать с путем к папке ПапкаДЛяФайлов$
что еще менять - не пойму
Как сделать чтоб с исходника брало данные не со второй строчки, а с первой? У меня csv без шапки.
Здравствуйте, Андрей.
Макрос предназначен для загрузки файлов CSV из интернета по ссылкам, - и макросу абсолютно неважно, какие в этих файлах используются разделители...
Если вы про второй файл с макросом, - то, помимо замены разделителей, надо ещё задать количество столбцов в файлах CSV.
За это отвечает число 3 (вам надо поставить 15) в строке
DataArr = CSVfolder2Array(ПапкаДляФайлов$, 3, "", ErrorsArray)PS: Возможно, надо поменять в коде что-то ещё.
Добрый день!
У меня CSV файлы с разделителем ",". Данный пример написан под разделитель ";". Если я меняю своим CSV файлы с "," на ";" - все работает великолепно. Однако у меня очень много этих файлов (порядка 1600). Заходить в каждый и менять разделитель трудоемко. Решение "в лоб" поменять в тексте кода Функции CSVfolder2Array все ";" на "," результата не принесло. Возможно все дело в самом CSV файле? Строка файла:
2008-04-11,RIG1C,200804,SSF,100,146.27,146.42,14.10,14.86,14.16,-2.32,128,0,0,223
Хотя с ";" работает. Что нужно переписать чтоб работало с запятыми?
Заранее спасибо!
Для авторизации с использованием ЭЦП нужен совсем другой код, намного сложнее.
К сожалению, мне тут сложно вам что-то посоветовать, - я ни разу не использовал ЭЦП для авторизации средствами макроса.
Скажите пожалуйста, а что нужно добавить в макрос, чтобы проходила авторизация с помощью ЭЦП (сертификата). Ссылка на CSV документ осуществляется с помощью javascript
Вы мне поможете?
А вы попробуйте распечатать макросом формируемые ссылки
(командой типа Debug.Print URL$),
а потом скачать файл по этой ссылке.
И вы увидите сообщение:
Макрос не авторизуется на сайте - он просто пытается загрузить файл по ссылке.
Разумеется, веб-сервер отвечает ему отказом.
В вашем случае нужен совсем другой макрос - умеющий выполнять авторизацию на сайте.
Скажите пожалуйста в чём ошибка, не работает макрос. Спасибо.
DSub Main()
ПапкаДляФайлов$ = Replace(ThisWorkbook.FullName, ThisWorkbook.Name, "Файлы CSV\")
Dim dat As Date, date1 As Date, date2 As Date, n As Long, ok As Long
date1 = DateSerial(2012, 1, 22) ' стартовая дата
date2 = Now ' конечная дата (вчерашний день)
On Error Resume Next: MkDir ПапкаДляФайлов$ ' создаём папку для файлов, если её ещё нет
' шаблон ссылки на загружаемый файл
URL_template$ = "https://br.so-ups.ru/Export/csv/Gtp.aspx?date=23.01.2012>pIds=GIRKEN08=%%%%&tx_ms1cdu_pi1[format]=csv"
Dim pi As New ProgressIndicator: pi.Show "Загрузка данных с сайта http://so-ups.ru"
pi.StartNewAction , , , , , date2 - date1
For dat = date1 To date2 ' перебираем все даты
' формируем ссылку на очередной CSV файл
URL$ = Replace(URL_template$, "%%%%", Format(dat, "DD.MM.YYYY"))
' формируем имя сохраняемого файла
filename$ = ПапкаДляФайлов$ & Format(dat, "DD.MM.YYYY") & ".csv"
n = n + 1
pi.SubAction "Загружено файлов: " & ok & " (из " & n & ")", _
"Загрузка данных за дату " & Format(dat, "DD.MM.YYYY"), "Файл: " & filename$
DoEvents
If DownLoadFile(URL$, filename$) Then
ok = ok + 1 ': Debug.Print "Скачан файл: " & Filename$
Else
'MsgBox "Не удалось загрузить файл за дату " & Format(dat, "DD.MM.YYYY"), vbCritical
End If
Next dat
pi.Hide
End Sub
Отправить комментарий