Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Web запрос данных с сайта в таблицу - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Web запрос данных с сайта в таблицу (Макросы/Sub)
Web запрос данных с сайта в таблицу
alkar Дата: Суббота, 18.09.2021, 21:58 | Сообщение № 1
Группа: Пользователи
Ранг: Прохожий
Сообщений: 5
Репутация: 0 ±
Замечаний: 0% ±

Друзья, помогите, пожалуйста!
Могу показаться чайником, а для Вас это будут семечки, но у меня уже голова пухнет от всех этих GET POST и т.п. запросов!! (
Никак не могу сложить пазл, прошу помощи
Дано: файл эксель с двумя столбцами A - Code и В - Brand со значениями на скажем 1000 строк. Есть два постоянных значения ClientID = 10200 и Password = turg0404
Есть http://www.mikado-parts.ru/ws1/service.asmx?op=CodeBrandStockInfo куда это нужно будет запрашивать.
Мне нужно получить столбец С со значениями PriceRUR, из результата выполнения функции CodeBrandStockInfo (полученного после нажатия кнопки Запуск)
Например А = GDB3331, В = TRW, С = 2113.02
 
Ответить
СообщениеДрузья, помогите, пожалуйста!
Могу показаться чайником, а для Вас это будут семечки, но у меня уже голова пухнет от всех этих GET POST и т.п. запросов!! (
Никак не могу сложить пазл, прошу помощи
Дано: файл эксель с двумя столбцами A - Code и В - Brand со значениями на скажем 1000 строк. Есть два постоянных значения ClientID = 10200 и Password = turg0404
Есть http://www.mikado-parts.ru/ws1/service.asmx?op=CodeBrandStockInfo куда это нужно будет запрашивать.
Мне нужно получить столбец С со значениями PriceRUR, из результата выполнения функции CodeBrandStockInfo (полученного после нажатия кнопки Запуск)
Например А = GDB3331, В = TRW, С = 2113.02

Автор - alkar
Дата добавления - 18.09.2021 в 21:58
wild_pig Дата: Воскресенье, 19.09.2021, 01:18 | Сообщение № 2
Группа: Проверенные
Ранг: Обитатель
Сообщений: 513
Репутация: 97 ±
Замечаний: 0% ±

2003, 2013
[vba]
Код
Sub СЕМЕЧКИ()
    Dim url$, txt$
    Dim i&
'------------------
    With ActiveSheet
        a = .UsedRange.Value
        For i = 2 To UBound(a)
            If a(i, 1) <> "" And a(i, 2) <> "" Then
                url = "https://www.mikado-parts.ru/ws1/service.asmx/CodeBrandStockInfo?Code=" & a(i, 1) & "&Brand=" & a(i, 2) & "&ClientID=10200&Password=turg0404 HTTP/1.1"
                txt = GetHttp(url)
                .Cells(i, 3) = GetXml(txt, "CodeBrandResult/List/CodeBrandLine/PriceRUR")
            End If
        Next
    End With
    Beep
    MsgBox "Готово!"
End Sub

Function GetXml(ByVal XmlText As String, ByVal NodePath As String) As String
    With CreateObject("MSXML2.DOMDocument")
        .async = False
        .validateOnParse = False
        .LoadXML (XmlText)
        GetXml = .SelectSingleNode(NodePath).TEXT
    End With
End Function

Function GetHttp(ByVal url As String) As String
    With CreateObject("Microsoft.XMLHTTP")
        .Open "GET", url, "False"
        .setRequestHeader "Accept", "text/html,application/xhtml+xml,application/xml;q=0.9,image/webp,*/*;q=0.8"
        .setRequestHeader "Accept-Encoding", "gzip, deflate, sdch"
        .setRequestHeader "user-agent", "Mozilla/5.0 (Windows NT 6.1; WOW64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/44.0.2403.155 Safari/537.36"
        .setRequestHeader "Accept-Language", "ru,en-US;q=0.8,en;q=0.6"
        .setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
        .send
        If .Status = 200 Then
            GetHttp = .responsetext
        End If
    End With
End Function
[/vba]
 
Ответить
Сообщение[vba]
Код
Sub СЕМЕЧКИ()
    Dim url$, txt$
    Dim i&
'------------------
    With ActiveSheet
        a = .UsedRange.Value
        For i = 2 To UBound(a)
            If a(i, 1) <> "" And a(i, 2) <> "" Then
                url = "https://www.mikado-parts.ru/ws1/service.asmx/CodeBrandStockInfo?Code=" & a(i, 1) & "&Brand=" & a(i, 2) & "&ClientID=10200&Password=turg0404 HTTP/1.1"
                txt = GetHttp(url)
                .Cells(i, 3) = GetXml(txt, "CodeBrandResult/List/CodeBrandLine/PriceRUR")
            End If
        Next
    End With
    Beep
    MsgBox "Готово!"
End Sub

Function GetXml(ByVal XmlText As String, ByVal NodePath As String) As String
    With CreateObject("MSXML2.DOMDocument")
        .async = False
        .validateOnParse = False
        .LoadXML (XmlText)
        GetXml = .SelectSingleNode(NodePath).TEXT
    End With
End Function

Function GetHttp(ByVal url As String) As String
    With CreateObject("Microsoft.XMLHTTP")
        .Open "GET", url, "False"
        .setRequestHeader "Accept", "text/html,application/xhtml+xml,application/xml;q=0.9,image/webp,*/*;q=0.8"
        .setRequestHeader "Accept-Encoding", "gzip, deflate, sdch"
        .setRequestHeader "user-agent", "Mozilla/5.0 (Windows NT 6.1; WOW64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/44.0.2403.155 Safari/537.36"
        .setRequestHeader "Accept-Language", "ru,en-US;q=0.8,en;q=0.6"
        .setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
        .send
        If .Status = 200 Then
            GetHttp = .responsetext
        End If
    End With
End Function
[/vba]

Автор - wild_pig
Дата добавления - 19.09.2021 в 01:18
wild_pig Дата: Воскресенье, 19.09.2021, 01:19 | Сообщение № 3
Группа: Проверенные
Ранг: Обитатель
Сообщений: 513
Репутация: 97 ±
Замечаний: 0% ±

2003, 2013
[vba]
Код
Sub СЕМЕЧКИ()
    Dim url$, txt$
    Dim i&
'------------------
    With ActiveSheet
        a = .UsedRange.Value
        For i = 2 To UBound(a)
            If a(i, 1) <> "" And a(i, 2) <> "" Then
                url = "https://www.mikado-parts.ru/ws1/service.asmx/CodeBrandStockInfo?Code=" & a(i, 1) & "&Brand=" & a(i, 2) & "&ClientID=10200&Password=turg0404 HTTP/1.1"
                txt = GetHttp(url)
                .Cells(i, 3) = GetXml(txt, "CodeBrandResult/List/CodeBrandLine/PriceRUR")
            End If
        Next
    End With
    Beep
    MsgBox "Готово!"
End Sub

Function GetXml(ByVal XmlText As String, ByVal NodePath As String) As String
    With CreateObject("MSXML2.DOMDocument")
        .async = False
        .validateOnParse = False
        .LoadXML (XmlText)
        GetXml = .SelectSingleNode(NodePath).TEXT
    End With
End Function

Function GetHttp(ByVal url As String) As String
    With CreateObject("Microsoft.XMLHTTP")
        .Open "GET", url, "False"
        .setRequestHeader "Accept", "text/html,application/xhtml+xml,application/xml;q=0.9,image/webp,*/*;q=0.8"
        .setRequestHeader "Accept-Encoding", "gzip, deflate, sdch"
        .setRequestHeader "user-agent", "Mozilla/5.0 (Windows NT 6.1; WOW64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/44.0.2403.155 Safari/537.36"
        .setRequestHeader "Accept-Language", "ru,en-US;q=0.8,en;q=0.6"
        .setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
        .send
        If .Status = 200 Then
            GetHttp = .responsetext
        End If
    End With
End Function
[/vba]
 
Ответить
Сообщение[vba]
Код
Sub СЕМЕЧКИ()
    Dim url$, txt$
    Dim i&
'------------------
    With ActiveSheet
        a = .UsedRange.Value
        For i = 2 To UBound(a)
            If a(i, 1) <> "" And a(i, 2) <> "" Then
                url = "https://www.mikado-parts.ru/ws1/service.asmx/CodeBrandStockInfo?Code=" & a(i, 1) & "&Brand=" & a(i, 2) & "&ClientID=10200&Password=turg0404 HTTP/1.1"
                txt = GetHttp(url)
                .Cells(i, 3) = GetXml(txt, "CodeBrandResult/List/CodeBrandLine/PriceRUR")
            End If
        Next
    End With
    Beep
    MsgBox "Готово!"
End Sub

Function GetXml(ByVal XmlText As String, ByVal NodePath As String) As String
    With CreateObject("MSXML2.DOMDocument")
        .async = False
        .validateOnParse = False
        .LoadXML (XmlText)
        GetXml = .SelectSingleNode(NodePath).TEXT
    End With
End Function

Function GetHttp(ByVal url As String) As String
    With CreateObject("Microsoft.XMLHTTP")
        .Open "GET", url, "False"
        .setRequestHeader "Accept", "text/html,application/xhtml+xml,application/xml;q=0.9,image/webp,*/*;q=0.8"
        .setRequestHeader "Accept-Encoding", "gzip, deflate, sdch"
        .setRequestHeader "user-agent", "Mozilla/5.0 (Windows NT 6.1; WOW64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/44.0.2403.155 Safari/537.36"
        .setRequestHeader "Accept-Language", "ru,en-US;q=0.8,en;q=0.6"
        .setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
        .send
        If .Status = 200 Then
            GetHttp = .responsetext
        End If
    End With
End Function
[/vba]

Автор - wild_pig
Дата добавления - 19.09.2021 в 01:19
alkar Дата: Воскресенье, 19.09.2021, 20:28 | Сообщение № 4
Группа: Пользователи
Ранг: Прохожий
Сообщений: 5
Репутация: 0 ±
Замечаний: 0% ±

wild_pig, спасибо Вам большое за оперативную работу!
Только сейчас появилась возможность протестировать и пока не получается: ругается на строку GetXml = .SelectSingleNode(NodePath).Text


Сообщение отредактировал alkar - Воскресенье, 19.09.2021, 20:42
 
Ответить
Сообщениеwild_pig, спасибо Вам большое за оперативную работу!
Только сейчас появилась возможность протестировать и пока не получается: ругается на строку GetXml = .SelectSingleNode(NodePath).Text

Автор - alkar
Дата добавления - 19.09.2021 в 20:28
doober Дата: Воскресенье, 19.09.2021, 21:24 | Сообщение № 5
Группа: Друзья
Ранг: Ветеран
Сообщений: 817
Репутация: 301 ±
Замечаний: 0% ±

Excel 2010
А что бы Вы хотели, если логин и пароль не валидны.
Тест показал.



 
Ответить
СообщениеА что бы Вы хотели, если логин и пароль не валидны.
Тест показал.


Автор - doober
Дата добавления - 19.09.2021 в 21:24
alkar Дата: Воскресенье, 19.09.2021, 21:37 | Сообщение № 6
Группа: Пользователи
Ранг: Прохожий
Сообщений: 5
Репутация: 0 ±
Замечаний: 0% ±

doober, они валидны

Мне кажется NodePath где то как переменную еще нужно прописать в коде, но это не точно (
Ругается на "run time error 91 object variable or with block variable not set" по строке GetXml = .SelectSingleNode(NodePath).Text


Сообщение отредактировал alkar - Воскресенье, 19.09.2021, 22:18
 
Ответить
Сообщениеdoober, они валидны

Мне кажется NodePath где то как переменную еще нужно прописать в коде, но это не точно (
Ругается на "run time error 91 object variable or with block variable not set" по строке GetXml = .SelectSingleNode(NodePath).Text

Автор - alkar
Дата добавления - 19.09.2021 в 21:37
doober Дата: Воскресенье, 19.09.2021, 23:02 | Сообщение № 7
Группа: Друзья
Ранг: Ветеран
Сообщений: 817
Репутация: 301 ±
Замечаний: 0% ±

Excel 2010
С патчем все нормально.Не находит такой элемент-вот и ошибка.
Замените на этот код[vba]
Код
Function GetXml(ByVal XmlText As String, ByVal NodePath As String) As String
    
    Debug.Print XmlText ' Посмотрите, что приходит в ответ
    With CreateObject("MSXML2.DOMDocument")
        .async = False
        .validateOnParse = False
        .LoadXML (XmlText)
        Set nod = .SelectSingleNode(NodePath)
        If Not nod Is Nothing Then
        GetXml = .Text
        End If
    End With
End Function
[/vba]Я изменил патч, и получил результат


 
Ответить
СообщениеС патчем все нормально.Не находит такой элемент-вот и ошибка.
Замените на этот код[vba]
Код
Function GetXml(ByVal XmlText As String, ByVal NodePath As String) As String
    
    Debug.Print XmlText ' Посмотрите, что приходит в ответ
    With CreateObject("MSXML2.DOMDocument")
        .async = False
        .validateOnParse = False
        .LoadXML (XmlText)
        Set nod = .SelectSingleNode(NodePath)
        If Not nod Is Nothing Then
        GetXml = .Text
        End If
    End With
End Function
[/vba]Я изменил патч, и получил результат

Автор - doober
Дата добавления - 19.09.2021 в 23:02
alkar Дата: Воскресенье, 19.09.2021, 23:15 | Сообщение № 8
Группа: Пользователи
Ранг: Прохожий
Сообщений: 5
Репутация: 0 ±
Замечаний: 0% ±

Пришлите Ваш ID отсюда http://www.mikado-parts.ru/ws1/service.asmx?op=Get_MyIP
я добавлю его в настройки сайта и у Вас появится доступ, будет легче искать решение.
А пока не получается. Я вставляю Вашу функцию в код вместо прежнего варианта и при прогоне макроса в 3 столбец ничего не приходит, хотя "Готово!" вываливается


Сообщение отредактировал alkar - Воскресенье, 19.09.2021, 23:16
 
Ответить
СообщениеПришлите Ваш ID отсюда http://www.mikado-parts.ru/ws1/service.asmx?op=Get_MyIP
я добавлю его в настройки сайта и у Вас появится доступ, будет легче искать решение.
А пока не получается. Я вставляю Вашу функцию в код вместо прежнего варианта и при прогоне макроса в 3 столбец ничего не приходит, хотя "Готово!" вываливается

Автор - alkar
Дата добавления - 19.09.2021 в 23:15
doober Дата: Воскресенье, 19.09.2021, 23:56 | Сообщение № 9
Группа: Друзья
Ранг: Ветеран
Сообщений: 817
Репутация: 301 ±
Замечаний: 0% ±

Excel 2010
Чудес не бывает.
Попробуйте этот файл
К сообщению приложен файл: 0607765.xlsm(18.7 Kb)


 
Ответить
СообщениеЧудес не бывает.
Попробуйте этот файл

Автор - doober
Дата добавления - 19.09.2021 в 23:56
alkar Дата: Понедельник, 20.09.2021, 00:13 | Сообщение № 10
Группа: Пользователи
Ранг: Прохожий
Сообщений: 5
Репутация: 0 ±
Замечаний: 0% ±

doober, первый раз я открыл Ваш файл, получилось великолепно.
Следующие разы перестало получаться. Наверно попробую поставить посвежее Excel
 
Ответить
Сообщениеdoober, первый раз я открыл Ваш файл, получилось великолепно.
Следующие разы перестало получаться. Наверно попробую поставить посвежее Excel

Автор - alkar
Дата добавления - 20.09.2021 в 00:13
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Web запрос данных с сайта в таблицу (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

Яндекс.Метрика Яндекс цитирования Jobsora jooble
© 2010-2021 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!