 Программа предназначена для скачивания файлов CSV с сайта за указанный диапазон дат.Скачиваемые CSV файлы содержат почасовые данные о мощности генерации и потребления ОЭС заданного округа. Исходными данными для программы выступают 2 даты - начальная и конечная. В ходе загрузки отображается прогресс-бар. Макрос загрузки файлов вы найдете во вложении к статье. Создаваемые файлы получают имена типа
Все скачанные файлы помещаются в подпапку с именем Файлы 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.
|
|||||||||
Комментарии
Вы мне поможете?
А вы попробуйте распечатать макросом формируемые ссылки
(командой типа 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
Отправить комментарий