Получить полную информацию о выпадающем на веб-сайте с помощью макроса

Question

обычно я использую таблицу Excel для загрузки своих данных на сайт. но я понял, что со временем новые дополнения могут быть добавлены в выпадающий список, и, к сожалению, я не знаю, есть ли что-то добавлено или нет. Поэтому я хочу добавить кнопку refre sh в свой лист Excel, чтобы обновить данные sh внутри моего Excel и получить данные из выпадающего меню веб-сайта. ниже вы можете найти код на веб-сайте. Кстати, я не могу поделиться ссылкой, потому что она находится за брандмауэром и учетными данными. так вот код

        <select name="ddfener" id="ddlfener" tabindex="2" class="normalText">
    <option value="0">Select a fener....</option>
    <option value="81ca032h">ahmet</option>
    <option value="345">mehmet</option>
    <option value="123">ayse</option>

Мне нужно загрузить эти данные, как

 81ca032h  ahmet
 345       mehmet
 123       ayse

спасибо

Answer 1

Вы должны настроить макрос для считанных значений, чтобы они оказались в нужных местах в вашей таблице Excel. Все остальное в комментариях к макросу:

Sub ReadDropdownValues()

  Dim browser As Object
  Dim url As String
  Dim nodeDropdown As Object
  Dim nodesOption As Object
  Dim optionTagNo As Long
  'Only for this demo
  'You write the single readed
  'values to your Excel table
  Dim result As String

  'Place your internal url here
  url = "file:///E:/testDropdown.htm"

  'Initialize Internet Explorer, set visibility,
  'call URL and wait until page is fully loaded
  '
  'This could be problematic on the intranet due to security guidelines
  'Set browser = CreateObject("InternetExplorer.Application")
  '
  'Try this instead to initialize the IE
  Set browser = GetObject("new:{D5E8041D-920F-45e9-B8FB-B1DEB82C6E5E}")
  browser.Visible = False 'Set to 'True' to see the IE
  browser.navigate url
  Do Until browser.ReadyState = 4: DoEvents: Loop

  'Get dropdown html structure
  On Error Resume Next
  Set nodeDropdown = browser.document.getElementByID("ddlfener")
  On Error GoTo 0

  'Check if object 'nodeDropdown' was build
  If Not nodeDropdown Is Nothing Then
    'Create node collection of option tags from object 'nodeDropdown'
    Set nodesOption = nodeDropdown.getElementsByTagName("option")

    'Loop through all option tags from, the second one
    '(The first one is only the placeholder 'Select a fener....')
    For optionTagNo = 1 To nodesOption.Length - 1
      'Get the value of the attribute 'value'
      result = result & Trim(nodesOption(optionTagNo).getAttribute("value"))
      'Insert tab only for demo string
      result = result & Chr(9)
      'Get dropdown value
      result = result & Trim(nodesOption(optionTagNo).innertext)
      'Insert new line only for demo string
      result = result & Chr(13)
    Next optionTagNo
  Else
    'If object 'nodeDropdown' wasn't build
    result = "Dropdown not found"
  End If

  'Clean up
  browser.Quit
  Set browser = Nothing
  Set nodeDropdown = Nothing
  Set nodesOption = Nothing

  'Show demo result
  MsgBox result
End Sub