ExcelへのVBAハイパーリンクの代わりにデータ名と電話番号を取得するにはどうすればよいですか？

Question

Sub GetAllLinks() 

    Dim IE As Object 

    Set IE = CreateObject("InternetExplorer.Application") 
    IE.Visible = True 
    url_name = "http://www.trovanumeri.com/?azione=cerca&cerca=portoscuso" 
    If url_name = "" Then Exit Sub 
    IE.navigate url_name 
    Do 
     DoEvents 
    Loop Until IE.readyState = 4 
    '<a href="http://google.com">Click Here 
    Set AllHyperLinks = IE.document.getElementsByTagName("A") 
    Foglio1.ListBox1.Clear 
    'this is the code 
    For Each hyper_link In AllHyperLinks 
     Foglio1.ListBox1.AddItem hyper_link 
    Next 
    MsgBox "Done!" 

End Sub 

Answer 1

は、IEの自動化とDOM処理を経由してからデータを取得する方法を示し、以下の例を見てみましょう：

Option Explicit 

Sub GetData() 

    Dim oIE As Object 
    Dim lCurRow As Long 
    Dim lResultIndex As Long 
    Dim sUrl As String 
    Dim oTable0 As Object 
    Dim oTable1 As Object 
    Dim oTable2 As Object 
    Dim oTable3 As Object 
    Dim sTbl3Text As String 
    Dim cAncorNodes As Object 
    Dim oAncorNode As Variant 
    Dim sRowText As String 
    Dim oRowNode As Object 
    Dim aData() As Variant 

    Set oIE = CreateObject("InternetExplorer.Application") 
    With oIE 
     .Visible = True 
     Sheets(1).Cells.Delete 
     lCurRow = 1 ' Worksheet rows counter 
     lResultIndex = 0 ' Search result index counter 
     Do 
      ' Navigate to the page 
      sUrl = "http://www.trovanumeri.com/?azione=cerca&cerca=cagliari&da=" & lResultIndex 
      .Navigate sUrl 
      ' Wait IE 
      Do While .ReadyState < 3 Or .Busy 
       DoEvents 
      Loop 
      ' Wait Document 
      Do Until .Document.ReadyState = "complete" 
       DoEvents 
      Loop 
      ' Retrieve target tables 
      Set oTable0 = .Document.getElementsByTagName("table")(0) 
      Set oTable1 = oTable0.getElementsByTagName("table")(1) 
      Set oTable2 = oTable1.getElementsByTagName("table")(3) 
      ' Get and process ancor nodes 
      Set cAncorNodes = oTable2.getElementsByTagName("a") 
      For Each oAncorNode In cAncorNodes 
       With CreateObject("Scripting.Dictionary") 
        ' Add .href to result 
        .Add .Count, oAncorNode.href 
        ' Get ancor's parent row 
        Set oRowNode = oAncorNode.ParentNode.ParentNode.ParentNode 
        Do 
         ' Add nonemtpy row to result 
         sRowText = Trim(Replace(oRowNode.innerText, vbCrLf, "")) 
         If sRowText <> "" Then .Add .Count, sRowText 
         ' If last row then exit 
         If IsNull(oRowNode.nextElementSibling) Then Exit Do 
         ' Proceed with next row 
         Set oRowNode = oRowNode.nextElementSibling 
         ' If net row contains oAncorNode then exit 
         If oRowNode.getElementsByTagName("a").Length > 0 Then Exit Do 
         DoEvents 
        Loop 
        ' Get results as array 
        aData = .Items 
       End With 
       ' Output array to worksheet row 
       With Sheets(1).Cells(lCurRow, 1) 
        .Resize(1, UBound(aData) + 1) = aData 
        .Select 
       End With 
       lCurRow = lCurRow + 1 
       DoEvents 
      Next 
      ' Get table containing 'Next' button 
      Set oTable3 = oTable0.getElementsByTagName("table")(7) 
      sTbl3Text = oTable3.innerText 
      ' If no 'Next' button then exit 
      If InStr(sTbl3Text, "Avanti >>") = 0 Then Exit Do 
      lResultIndex = lResultIndex + 10 
      DoEvents 
     Loop 
     .Quit 
    End With 

End Sub