Страницы: 1
RSS
Сохранить файл программно управляя окном IE "Сохранение" из VBA Excel
 

Проблема выросла из следующего. Была задача сохранения .pdf файла с сайта http://ras.arbitr.ru/. При использовании способов через URLDownloadToFile или WinHttp.WinHttpRequest задачу решить не получилось. Файлы скачивались "битые". Просмотреть их на компе не удавалось.

Убрав все лишнее из вышеуказанных способов выяснилось, что для любых других URL файлы .pdf скачиваются и просматриваются на компе нормально, а вот с сайта http://ras.arbitr.ru/ нет. Также выяснил, что если открыть файл .pdf в IE, а потом сохранить его через окно сохранения (Сtrl+Shft+s), то все номально. Вот и возникла необходимость вот так через мягкое место сделать програмку.

Как я понял необходимо пользоваться FindWindowEx. В инете есть описания, но мозаику сложить не могу. Мозг уже кипит. Прошу помощь.

Необходимо с использованием VBA сделать следующее:

1.           Открыть в IE .pdf файл по конкретной ссылке.

2.           Открыть окно сохранения в IE.

3.           В поле ввода "Имя файла" вставить конкретный путь и наименование файла "e:\111.pdf".

4.           Программно нажать кнопку "Сохранить", чтобы окно закрылось.

Код
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
Private Declare Function apiShowWindow Lib "user32" Alias "ShowWindow" _
            (ByVal Hwnd As Long, ByVal nCmdShow As Long) As Long
 
Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
         
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" _
                                     (ByVal hWnd1 As Long, _
                                      ByVal hWnd2 As Long, _
                                      ByVal lpsz1 As String, _
                                      ByVal lpsz2 As String) _
                                      As Long
 
Private Sub CommandButton1_Click()
 
  Dim IE1 As InternetExplorer
  Set IE1 = New InternetExplorer
  IE1.Visible = True
  apiShowWindow IE1.Hwnd, 3
  Do While (IE1.readyState <> 4) And (IE1.readyState <> 3): DoEvents: Loop
  While IE1.document Is Nothing: DoEvents: Wend
  Application.Wait (Now + TimeValue("0:00:5"))
  SendKeys ("^+s")
 
MsgBox "Закипаю!!!!! АААААААААААААААААААААА!!!!!!"
 
End Sub
 
Цитата
Как я понял необходимо пользоваться FindWindowEx
не обязательно
надо правильно передавать заголовки запроса (через WinHttpRequest), - тогда PDF файл скачается
 
Цитата
Игорь написал:
не обязательнонадо правильно передавать заголовки запроса (через WinHttpRequest), - тогда PDF файл скачается
т.е. поиграться вот с этим?
XMLHTTP.Open "GET", Replace(URL$, "\", "/"), "False"
 
Поставленная задача, а именно:
Необходимо с использованием VBA сделать следующее:

1.           Открыть в IE .pdf файл по конкретной ссылке.

2.           Открыть окно сохранения в IE.

3.           В поле ввода "Имя файла" вставить конкретный путь и наименование файла "e:\111.pdf".

4.           Программно нажать кнопку "Сохранить", чтобы окно закрылось.

решена с использованием ExecWB, FindWindow, FindWindowEx, SendMessage, PostMessage. Свойства окон для указания в FindWindow, FindWindowEx искал с помощью сторонней програмки Window Detective http://www.manhunter.ru/underground/1035_programmi_dlya_raboti_s_oknami_prilozhen­iy.html/. Как то так

Код
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function FindWindowEx& Lib "user32" _
Alias "FindWindowExA" (ByVal hWndParent As Long, ByVal hWndChildAfter As Long, ByVal lpClassName As String, ByVal lpWindowName As String)
 
Private Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByRef lParam As Any) As Long
Private Declare Function PostMessage Lib "user32.dll" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
 
Private Declare Function apiShowWindow Lib "user32" Alias "ShowWindow" _
            (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
 
Private Const WM_SETTEXT = &HC  'константа изменения текста
Private Const BM_CLICK = &HF5  'константа нажатие кнопки
 
 
Private Sub CommandButton1_Click()
   
  Dim IE1 As InternetExplorer
  Set IE1 = New InternetExplorer
  IE1.Visible = True  'делаем IE видимым
  apiShowWindow IE1.hwnd, 3   ' если вместо 11 ставим 3 то IE будет на весь экран
  IE1.navigate SsilkaFile  ' загружаем ссылку
  Do While (IE1.readyState <> 4) And (IE1.readyState <> 3): DoEvents: Loop  ' ждем окончания загрузки
  While IE1.document Is Nothing: DoEvents: Wend
  Application.Wait (Now + TimeValue("0:00:5"))  'делаем паузу
 
  IE1.ExecWB 4, 1 'открываем диалоговое окно "Сохранить как ..."
  Application.Wait (Now + TimeValue("0:00:2"))  'делаем паузу
 
  Dim hwnd, hwndEdit, hwndEx, hwndBtnSave As Long
  hwnd = FindWindow(vbNullString, "Сохранение") 'находим хендл окна "Сохранить как.." по названию окна "Сохранение"
   
  hwndEx = FindWindowEx(hwnd, 0, "DUIViewWndClassName", vbNullString)
  hwndEx = FindWindowEx(hwndEx, 0, "DirectUIHWND", vbNullString)
  hwndEx = FindWindowEx(hwndEx, 0, "FloatNotifySink", vbNullString)
  hwndEx = FindWindowEx(hwndEx, 0, "ComboBox", vbNullString)
  hwndEx = FindWindowEx(hwndEx, 0, "Edit", vbNullString) 'последовательно добираемся до Эдит "Имя файла" т.е. куда будем сохранять файл
 
 
  SendMessage hwndEx, WM_SETTEXT, 0, ByVal "e:\999.pdf" 'меняем путь сохранения и имя конечного файла на необходимый
   
  hwndBtnSave = FindWindowEx(hwnd, 0, "Button", "Со&хранить") 'ищем хендл кнопки "Сохранить"
  PostMessage hwndBtnSave, BM_CLICK, 0, 0 'нажимаем кнопку "Сохранить
 
  IE1.Quit
End Sub
Изменено: puuh - 24.07.2018 17:23:33
 
Цитата
puuh написал:
через WinHttp.WinHttpRequest задачу решить не получилось
У меня, по крайнем мере, качает так:
Код
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
FILE_Name = Replace(Split(PDF_Url, "/")(UBound(Split(PDF_Url, "/"))), "%20", "")
DWN_Path = "C:\Users\" & Environ("UserName") & "\Downloads\" & FILE_Name
 
Set HTTPR = CreateObject("WinHTTP.WinHTTPRequest.5.1")
 
HTTPR.Open "GET", PDF_Url, False
HTTPR.Send
 
FileData = HTTPR.ResponseBody
Set HTTPR = Nothing
 
FileNum = FreeFile
Open DWN_Path For Binary Access Write As #FileNum
    Put #FileNum, 1, FileData
Close #FileNum
 
Цитата
puuh написал:
Я пытаюсь пришить к своему коду ваш начиная со строки 27 )) Но почему-то ничего не работает.
По ссылке в IE открывается диалоговое окно  которое Просмотр загрузок - Internet Explorer  и потом ничего не работает.
то ли findwindow не срабатывает, то ли что то еще


Я не знаю прилично сюда свой код выкладывать, но задача у меня примерно такая же как те 4 пункта что вы описали.
Изменено: S M - 24.08.2021 02:09:37
Страницы: 1
Читают тему
Наверх
Loading...