Html 无法通过VBA在internet explorer中选择下拉列表

我正在尝试从此网站上的列表中选择货币：

问题是这些字段中输入的值，基本上选择的是货币，但手动输入时会刷新。通过宏，可以输入值，但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

”选项显式
子转换器（）
模糊的物体
作为HTMLDocument的Dim doc
Dim inputval，returnval作为字符串
暗淡的开始时间是双倍的
开始时间=计时器
Dim Curr1，Curr2作为字符串
作为整数的Dim i
将mywb设置为工作簿
将myws设置为工作表
设置mywb=ThisWorkbook
设置myws=mywb.Worksheets（“Ui”）
设置ie=CreateObject（“InternetExplorer.Application”）
可见=真实
'导航到URL
即“导航”https://www1.oanda.com/currency/converter/"
'让浏览器完全加载
在忙或准备状态4时执行
Application.Wait DateAdd（“s”，1，Now）
环
Set doc=ie.document
范围（单元格（4，9），单元格（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
'输入货币值
doc.getElementById（“报价单\货币\输入”）。值=Curr1
doc.getElementById（“基本货币输入”）.Item.innerText=Curr2
'输入要转换的值
returnval=doc.getElementById（“基本金额输入”）。值
“在忙或准备状态4时执行
Application.Wait（现在+时间值（“0:00:05”））
'循环
myws.Activate
myws.Cells（4+i，9）.Value=returnval
i=i+1
环
”他说
“MsgBox”货币已转换“&vbNewLine&“耗时-”&Format（（Timer-starttime）/86400，“hh:mm:ss”）
端接头

多么大的挑战！我当然不是最没有经验的人，但也肯定不是最好的

当我读到你的文本时，我已经很清楚这些是HTML事件。我已经知道这个网站，但我不知道会发生什么。我现在投资了好几个小时，但最终还是成功了

以下带有附加子（）的宏解决了您的问题。有关更多信息，请参阅宏中的注释。解决方案对我来说非常困难，但我什么也没学到，因为所有的知识都在那里。但不是这样

最后一切似乎都很简单。你不会相信我尝试了多少事件组合

以这个宏为例，它可以工作：

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

---

你好，我已经测试过了，它工作得非常完美。非常感谢您提供解决方案，我非常感谢您的努力。你真的是一个天才，这是我在这里的第一个问题，我很高兴我得到了一个快速和完全按照我的期望回答。我理解并珍视您通过尝试各种事件和可能的方式使其发挥作用所付出的努力和时间。非常感谢！：）

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