Как получить гиперссылки из интернет-исследователя из VBA

Question

Я пытаюсь получить ссылки на различные сектора (основные материалы, конгломераты и т. Д.) На веб-сайте https://biz.yahoo.com/p/s_conameu.html.

У меня есть код ниже, но так как этот сайт не использует идентификаторы, чтобы установить, какими будут эти ссылки, я не знаю, как на самом деле найти ссылки. Кроме того, ссылки на самом деле являются лишь частичными. Я знаю, что мне нужно добавить, чтобы сделать их полными (добавьте https://biz.yahoo.com/p/ перед частичной ссылкой в ​​html-файле. Первая ссылка, которую я вижу, появляется в строке 238 html, но я не уверен, как на самом деле искать и найти это, поскольку имена секторов могут измениться в будущем. Я пытаюсь сделать это агностиком, где он всегда может искать этот список и тянуть все ссылки.

Вот снимок html, показывающий ссылку (начинается в строке 236):

nowrap 
bgcolor=ffffee><a 
href=1conameu.html><font 
face=arial 
size=-1>Basic Materials</a></td><td 
align=right 
bgcolor=ffffff><font 
face=arial 
size=-1>-0.13</font></td><td 
align=right 
bgcolor=ffffff><font 
face=arial 
size=-1>293348.2B</font></td><td 
align=right 
bgcolor=ffffff><font 
face=arial 
size=-1>17.42</font></td><td 
align=right 
bgcolor=ffffff><font 
face=arial 
size=-1>6.50</font></td><td 
align=right 
bgcolor=ffffff><font 
face=arial 
size=-1>4.12</font></td><td 
align=right 
bgcolor=ffffff><font 
face=arial 
size=-1>69.76</font></td><td 
align=right 
bgcolor=ffffff><font 
face=arial 
size=-1>3.09</font></td><td 
align=right 
bgcolor=ffffff><font 
face=arial 
size=-1>1.35</font></td><td 
align=right 
bgcolor=ffffff><font 
face=arial 
size=-1>6.48</font></td></tr><tr><td 
nowrap 
bgcolor=ffffee><a 
href=2conameu.html><font 
face=arial 
size=-1>Conglomerates</a></td><td 

Вот код, где я захватить веб-сайт и получить содержимое

Public Sub clicklick() 
Dim internet As Object 
Dim html As HTMLDocument 
Dim internetdata As Object 
Dim div_result As Object 
Dim header_links As Object 
Dim link As Object 
Dim URL As String 
Dim i As Integer 

Set internet = CreateObject("InternetExplorer.Application") 
internet.Visible = False 

URL = "https://biz.yahoo.com/p/s_conameu.html" 
internet.Navigate URL 

While internet.Busy 
    DoEvents 
Wend 

Application.Wait Now + TimeSerial(0, 0, 5) 

Set internetdata = internet.Document 
Set div_result = internetdata.getElementById("res") // This does not work (obviously, but not sure how to really search). Returns nothing. 

Set header_links = div_result.getelementsbytagname("h3") //This fails because div_result has nothing. 
MsgBox html.DocumentElement.innerHTML 
MsgBox div_result 
SPws.Cells.ClearContents 
For Each h In header_links 
    Set link = h.ChildNodes.Item(0) 
    SPws.Cells(Range("A" & Rows.count).End(xlUp).row + 1, 1) = link.href 
Next 

MsgBox "done" 

End Sub 

.

Благодарим вас за любую помощь. Я надеюсь, что смогу сделать то, что хочу, чтобы автоматизировать некоторые поиски.

спасибо, Alan

Answer 1

Вы можете сделать это. Он потянет все ссылки на странице, а затем вы сможете распечатать значения в ячейках.

x = 1 
For Each link In internet.document.Links 
    Cells(x, 1) = link 
    'or you can add your prefix URL and link at the same time 
    Cells(x, 1) = "https://biz.yahoo.com/p/" & link 
    x = x + 1 
Next 

Answer 2

Это может сработать для вас.

Sub Macro1() 

    Range("A1").Select 
    With ActiveSheet.QueryTables.Add(Connection:= _ 
     "URL;https://biz.yahoo.com/p/s_conameu.html", Destination:=Range("$A$1")) 
     .CommandType = 0 
     .Name = "s_conameu_1" 
     .FieldNames = True 
     .RowNumbers = False 
     .FillAdjacentFormulas = False 
     .PreserveFormatting = True 
     .RefreshOnFileOpen = False 
     .BackgroundQuery = True 
     .RefreshStyle = xlInsertDeleteCells 
     .SavePassword = False 
     .SaveData = True 
     .AdjustColumnWidth = True 
     .RefreshPeriod = 0 
     .WebSelectionType = xlSpecifiedTables 
     .WebFormatting = xlWebFormattingNone 
     .WebTables = "4" 
     .WebPreFormattedTextToColumns = True 
     .WebConsecutiveDelimitersAsOne = True 
     .WebSingleBlockTextImport = False 
     .WebDisableDateRecognition = False 
     .WebDisableRedirections = False 
     .Refresh BackgroundQuery:=False 
    End With 
End Sub