无法通过 VBA 在 Internet Explorer 中 select 下拉列表

Question

我正在尝试 select 来自本网站列表的货币：https://www1.oanda.com/currency/converter/

问题是在这些字段中输入了值，selection 基本上是货币，但当我们手动输入时它会刷新。通过宏，输入值但 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

Answer 1

真是个挑战！我当然不是经验最少的人，但肯定也不是最好的。

当我阅读您的文字时，我已经清楚这些是 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

无法通过 VBA 在 Internet Explorer 中 select 下拉列表

Unable to select dropdown list in internet explorer through VBA

html

excel

vba

browser-automation

web-scraping