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

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 表格中的正确位置。其他一切都在宏的 cmets 中：

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