Невозможно выбрать выпадающий список в проводнике inte rnet через VBA - PullRequest
Новая
       20

Невозможно выбрать выпадающий список в проводнике inte rnet через VBA

0 голосов
/ 19 января 2020

Я пытаюсь выбрать валюту из списка на этом веб-сайте: https://www1.oanda.com/currency/converter/

Проблема в том, что значение вводится в эти поля, выбор в основном валют, но он обновляется, когда мы вводим его вручную. Через макрос вводится значение, но javascript или любой другой фоновой сцены для преобразования значений не происходит. Я не могу использовать любой другой веб-сайт для конвертации валюты. Любая помощь будет принята с благодарностью.

значения валют (в листе Excel) выводятся для переменных curr1, curr2

ЗДЕСЬ КОД 

'Option Explicit
Sub converter()

Dim ie As Object
Dim doc As HTMLDocument
Dim inputval, returnval As String
Dim starttime As Double
starttime = Timer
Dim Curr1, Curr2 As String
Dim i As Integer
Dim mywb As Workbook
Dim myws As Worksheet
Set mywb = ThisWorkbook
Set myws = mywb.Worksheets("Ui")

Set ie = CreateObject("InternetExplorer.Application")
ie.Visible = True

'Navigating to the URL
ie.navigate "https://www1.oanda.com/currency/converter/"

'Letting the browser fully load
Do While ie.Busy Or ie.readyState <> 4
Application.Wait DateAdd("s", 1, Now)
Loop


Set doc = ie.document
Range(Cells(4, 9), Cells(Rows.Count, 9)).ClearContents

Do While myws.Cells(4 + i, 4).Value <> ""

Curr1 = myws.Cells(4 + i, 5).Value
Curr2 = myws.Cells(4 + i, 7).Value
inputval = myws.Cells(4 + i, 8).Value


'ENTERRING CURRENCY VALUES
doc.getElementById("quote_currency_input").Value = Curr1
doc.getElementById("base_currency_input").Item.innerText = Curr2

'ENTERING VALUE TO BE CONVERTED
returnval = doc.getElementById("base_amount_input").Value


'Do While IE.Busy Or IE.readyState <> 4
Application.Wait (Now + TimeValue("0:00:05"))
'Loop


myws.Activate
myws.Cells(4 + i, 9).Value = returnval


i = i + 1
Loop

'IE.Quit
'MsgBox "Currencies have been converted" & vbNewLine & "Time Taken - " & Format((Timer - starttime) / 86400, "hh:mm:ss")
End Sub

1 Ответ

0 голосов
/ 20 января 2020

Какой вызов! Я, конечно, не наименее опытный человек, но, конечно, не самый лучший.

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

Следующий макрос с дополнительным Sub () решает вашу проблему. Для получения дополнительной информации, пожалуйста, обратитесь к комментариям в макросе. Решение было очень трудным для меня, но я ничему не научился, потому что все знания были там. Но не так.

В конце концов, все кажется простым. Вы не поверите, сколько комбинаций событий я пробовал.

Возьмите этот макрос, он работает: 

Sub OandaCurrencyConverter()

Dim ie As Object
Dim doc As Object
Dim nodeCurrencyDropdown As Object
Dim nodeAllCurrencies As Object
Dim nodeOneCurrency As Object
Dim starttime As Double
Dim Curr As String
Dim row As Long
Dim i As Byte
Dim leftRightIdentifier As String
Dim myws As Worksheet

  starttime = Timer
  Set myws = ThisWorkbook.Worksheets("Ui")
  myws.Range(myws.Cells(4, 9), myws.Cells(myws.Rows.Count, 9)).ClearContents 'Delete previous results

  'Initialize Internet Explorer, set visibility,
  'call URL and wait until page is fully loaded
  Set ie = CreateObject("internetexplorer.application")
  ie.Visible = False
  ie.navigate "https://www1.oanda.com/currency/converter/"
  Do Until ie.readyState = 4: DoEvents: Loop
  Set doc = ie.document

  'Get results
  Do While myws.Cells(4 + row, 4).Value <> ""
    'ENTERING VALUE TO BE CONVERTED
    'If this value is entered first, the desired result is calculated
    'automatically when the currencies are set in the dropdowns
    doc.getElementById("quote_amount_input").Value = myws.Cells(4 + row, 8).Value

    'ENTERRING CURRENCIES
    For i = 0 To 1
      If i = 0 Then
        'Left currency
        leftRightIdentifier = "quote"
        Curr = myws.Cells(4 + row, 5).Value
      Else
        'Right currency
        leftRightIdentifier = "base"
        Curr = myws.Cells(4 + row, 7).Value
      End If

      'Get the needed dropdown
      Set nodeCurrencyDropdown = doc.getElementById(leftRightIdentifier & "_currency_list_container")

      'Generate node collection of all currencies in dropdown
      Set nodeAllCurrencies = nodeCurrencyDropdown.getElementsByClassName("ltr_list_item")

      'Search the wanted currency in the single nodes
      For Each nodeOneCurrency In nodeAllCurrencies
        If InStr(1, nodeOneCurrency.innerText, Curr) > 0 Then
          Call TriggerEvent(doc, nodeOneCurrency, "mouseover")
          nodeOneCurrency.Click
          Exit For
        End If
      Next nodeOneCurrency
    Next i

    'Give a little time to calculate and get the result
    Application.Wait (Now + TimeValue("0:00:02"))
    myws.Cells(4 + row, 9).Value = doc.getElementById("base_amount_input").Value * 1

    'Next row
    row = row + 1
  Loop

  'Clean up
  ie.Quit
  Set ie = Nothing
  Set doc = Nothing
  Set nodeCurrencyDropdown = Nothing
  Set nodeAllCurrencies = Nothing
  Set nodeOneCurrency = Nothing

  'Show needed time
  MsgBox "Currencies have been converted" & vbNewLine & "Time Taken - " & Format((Timer - starttime) / 86400, "hh:mm:ss")
End Sub

И этот Sub () для запуска HTML событий: 

Private Sub TriggerEvent(htmlDocument As Object, htmlElementWithEvent As Object, eventType As String)

  Dim theEvent As Object

  htmlElementWithEvent.Focus
  Set theEvent = htmlDocument.createEvent("HTMLEvents")
  theEvent.initEvent eventType, True, False
  htmlElementWithEvent.dispatchEvent theEvent
End Sub
...