Как создать HTTP GET в Excel VBA

Question

Добрый день всем,

Я работаю над проектом для работы, в котором мне нужно получить значения транспортных средств на основе регистрационного номера и пробега и передать их в электронную таблицу Excel.

регистрационный номер и пробег хранятся в электронной таблице, но я застрял на том, с чего начать.

В прошлые выходные я создал грубое приложение VBA, которое выглядело следующим образом

Регистрационный номер ипробег указан в электронной таблице, но я застрял на том, с чего начать.

На прошлых выходных я создал грубое приложение VBA, которое выглядело следующим образом:

Sub GetHTMLDocument ()

Dim IE As New SHDocVw.InternetExplorer
Dim HTMLDoc As MSHTML.HTMLDocument
Dim Email As MSHTML.IHTMLElement
Dim Password As MSHTML.IHTMLElement
Dim LoginButton As MSHTML.IHTMLElement
Dim REG As MSHTML.IHTMLElement
Dim Mileage As MSHTML.IHTMLElement
Dim CAPGo As MSHTML.IHTMLElement
Dim objEvent
Dim GetValue As MSHTML.IHTMLElement

'Show IE for testing purposes
IE.Visible = True
'Navigate to web page
IE.Navigate "https://valuationanywhere.cap.co.uk/LoginPage?ReturnUrl=%2f%3f__hstc%3d208265677.8bb2d3e6c872f15cd37070c17648ee29.1549763639794.1549763639794.1549763639794.1%26__hssc%3d208265677.1.1549763639794%26__hsfp%3d959865525&__hstc=208265677.8bb2d3e6c872f15cd37070c17648ee29.1549763639794.1549763639794.1549763639794.1&__hssc=208265677.1.1549763639794&__hsfp=959865525"

'Loop an empty loop until done
Do While IE.ReadyState <> READYSTATE_COMPLETE
Loop

Set HTMLDoc = IE.Document

'inputs email address
Set Email = HTMLDoc.getElementById("inputLoginEmail")
Email.Value = "email"
'inputs password
Set Password = HTMLDoc.getElementById("inputLoginPassword")
Password.Value = "password"
'Clicks login button
Set LoginButton = HTMLDoc.getElementById("btnLogin")
LoginButton.Click

'Wait 3 seconds for page to load
Application.Wait (Now + TimeValue("0:00:03"))

Set objEvent = IE.Document.createEvent("HTMLEvents")

'Input REG into text box
Set REG = HTMLDoc.getElementById("vrm")
REG.Value = "reg"
'Input mileage into text box
Set Mileage = HTMLDoc.getElementById("mileage")
Mileage.Value = "181000"

'Fakes data entry as no focus is given to the text box
objEvent.initEvent "change", False, True
REG.dispatchEvent objEvent
Mileage.dispatchEvent objEvent

'Clicks Go button
Set tags = IE.Document.getElementsByTagName("button")
For Each tagx In tags
If tagx.innerText = "Go" Then
    tagx.Click
    Exit For
End If
Next

'Wait 3 seconds for popup to load
Application.Wait (Now + TimeValue("0:00:03"))

Set tags = IE.Document.getElementsByTagName("button")
For Each tagx In tags
If tagx.innerText = "Create NEW Valuation" Then
    tagx.Click
    Exit For
End If
Next

Это приведет к переходу на страницу, авторизации и поиску оценки.Однако в конечном итоге у нас будет база данных о сотнях автомобилей, на которые мы хотим получить оценки, и у нашего сервиса CAP есть несколько плагинов - https://soap.cap.co.uk/vrm/capvrm.asmx?op=VRMValuation

Есть ли способ, с помощью которого VBA может выбрать рег и пробег излист и вернуть значение?

Я не ожидаю, что кто-нибудь напишет все, что я хотел бы извлечь из этого.Но кто-нибудь может указать мне правильное направление?

С наилучшими пожеланиями, Крейг

Answer 1

По сути, вы можете прочитать диапазон из 2 столбцов из Excel, содержащий столбец A reg и пробег столбца B, в 2d массив, а затем зациклить измерение 1 массива от lbound до ubound (т.е. строки) и получить доступ к региструи пробег путем индексации в массиве.Затем вы можете объединить эти значения в тело запроса POST.Это понятно очень высокий уровень, показанный ниже.Вы прочитали бы ответ в XML-документе, чтобы вы могли разобрать необходимую информацию.

С точки зрения получения значений нам нужно будет увидеть соответствующий XML.

Option Explicit

Public Sub Test()
    'VBE > Tools > References > Add a reference to Microsoft HTML Object Library
    'other code

    Dim regAndMileage(), xmlDoc As Object
    Dim ws As Worksheet, r As Long, placeholderMileage As String, placeholderVR As String, body As String, response As String, html As HTMLDocument
    Const SUBSCRIBER_ID As Long = 123
    Const PASSWORD As String = "ABC"
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    Set html = New HTMLDocument
    Set xmlDoc = CreateObject("MSXML2.DOMDocument")
    regAndMileage = ws.Range("A2:B4").Value      'Create the array. Reg is in col A and mileage in col B. Check datatypes when passed are as expected (int - though Long should work; and string)

    body = "<?xml version=""1.0"" encoding=""utf-8""?>"
    body = body & Chr$(10) & "<soap:Envelope xmlns:xsi=""http://www.w3.org/2001/XMLSchema-instance"" xmlns:xsd=""http://www.w3.org/2001/XMLSchema"" xmlns:soap=""http://schemas.xmlsoap.org/soap/envelope/"">"
    body = body & Chr$(10) & "<soap:Body>"
    body = body & Chr$(10) & "<VRMValuation xmlns=""https://soap.cap.co.uk/vrm"">"
    body = body & Chr$(10) & "<SubscriberID>" & SUBSCRIBER_ID & " </SubscriberID>" 'int
    body = body & Chr$(10) & "<Password>" & PASSWORD & "</Password>" 'string
    body = body & Chr$(10) & "<VRM>placeholderVRM</VRM>" 'string
    body = body & Chr$(10) & "<Mileage>placeholderMileage</Mileage>" 'Mileage
    body = body & Chr$(10) & "<StandardEquipmentRequired>boolean</StandardEquipmentRequired>"
    body = body & Chr$(10) & "</VRMValuation>"
    body = body & Chr$(10) & "</soap:Body>"
    body = body & Chr$(10) & "</soap:Envelope>"

    With CreateObject("MSXML2.XMLHTTP")
        For r = LBound(regAndMileage, 1) To UBound(regAndMileage, 1)
            mileage = regAndMileage(r, 1)
            reg = regAndMileage(r, 2)
               'create your body here and concatentate in your mileage and reg variables
            .Open "POST", "protocol&domain/vrm/capvrm.asmx/VRMValuation", False
            .setRequestHeader "SOAPAction", "https://soap.cap.co.uk/vrm/VRMValuation"
            .setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
            .send Replace$(Replace$(body, placeholderVRM, reg), placeholderMileage, mileage)
            response = .responseText
            With xmlDoc
                .validateOnParse = True
                .setProperty "SelectionLanguage", "XPath"
                .async = False
                If Not .LoadXML(sResponse) Then
                    Err.Raise .parseError.ErrorCode, , .parseError.reason
                End If
            End With
            'Do something to extract values
        Next
    End With
End Sub

См. this для получения дополнительной информации о диапазонах и массивах.

Потенциально вам необходимо добавить в запрос длину содержимого и другую информацию.

SOAP-запросы