使用宏在网站上的下拉列表中获取完整数据

Question

通常，我使用Excel图表将数据上传到网站。但是我意识到，及时可以将新的添加项添加到下拉列表中，但不幸的是，我不知道是否添加了任何内容。因此，我想在Excel工作表中添加刷新按钮以刷新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