Получить гиперссылки из Интернета

Question

Я пытаюсь получить данные с гиперссылками из Интернета. Я скопировал данные из Интернета и вставил их в Excel. Все данные были вставлены в одну ячейку, и гиперссылка не переносилась, когда я разделял данные с текстом на столбцы.

Ссылка на источник: https://www.sec.gov/cgi-bin/current?q1=3&q2=6&q3=

Я также попытался сбросить данные в Excel, используя опцию «Из Интернета». К сожалению, нет гиперссылки. Не могли бы вы помочь с предложениями?

Спасибо

Answer 1

Макрос захватывает только все ссылки (второй и третий столбцы) из таблицы (которая не является таблицей). Это займет мгновение. Подождите, пока IE не закроется. Прочитайте комментарии в коде, пожалуйста:

Sub LinkList()

  Dim url As String
  Dim browser As Object
  Dim nodeContainer As Object
  Dim nodeAllLinks As Object
  Dim nodeOneLink As Object
  Dim currentRow As Long
  Dim controlCounter As Long

  ActiveSheet.Columns("B:B").NumberFormat = "@"
  ActiveSheet.Columns("D:D").NumberFormat = "@"
  currentRow = 2
  url = "https://www.sec.gov/cgi-bin/current?q1=3&q2=6&q3="

  'Initialize Internet Explorer, set visibility,
  'call URL and wait until page is fully loaded
  Set browser = CreateObject("internetexplorer.application")
  browser.Visible = True 'You can set this to False to make the IE invisible
  browser.navigate url
  Do Until browser.ReadyState = 4: DoEvents: Loop

  'Get the container with all links inside
  Set nodeContainer = browser.document.getElementsByTagName("pre")(0)
  'Get all links in a node collection
  Set nodeAllLinks = nodeContainer.getElementsByTagName("a")

  'Get each link
  For Each nodeOneLink In nodeAllLinks
    'Every second link should be in the same row than the first link of a HTML table row
    If controlCounter Mod 2 = 0 Then
      With ActiveSheet
        'Set link as link
        .Hyperlinks.Add Anchor:=.Cells(currentRow, 1), Address:=nodeOneLink.href, TextToDisplay:=nodeOneLink.href
        'Write the text of the link from the page to the column afte the link in Excel
        .Cells(currentRow, 2).Value = nodeOneLink.innertext
      End With
    Else
      With ActiveSheet
        .Hyperlinks.Add Anchor:=.Cells(currentRow, 3), Address:=nodeOneLink.href, TextToDisplay:=nodeOneLink.href
        .Cells(currentRow, 4).Value = nodeOneLink.innertext
      End With
      currentRow = currentRow + 1
    End If
    'Increment the control variable to devide between first and second link
    controlCounter = controlCounter + 1
  Next nodeOneLink

  'Clean up
  browser.Quit
  Set browser = Nothing
  Set nodeContainer = Nothing
  Set nodeAllLinks = Nothing
  Set nodeOneLink = Nothing
  ActiveSheet.Columns("A:D").EntireColumn.AutoFit
End Sub