Excelでサイトから情報取得。

2018年10月31日追記

Windows10にしたら動かなくなった。

環境

Windows 7 Professional 64bit
Excel 2016

環境設定

VBAのエディタを開いて、「ツール」→「参照設定」で、
Microsoft Internet Controls
Microsoft HTML Object Library

にチェックを入れる。

ソースコード

Sub getTest() 
  Dim ie As InternetExplorer 
   
  Set ie = CreateObject("internetexplorer.application") 
  ie.Visible = True 
  ie.Navigate ("http://gameinfo.na.leagueoflegends.com/en/game-info/champions/amumu/") 
  Do While ie.Busy Or ie.ReadyState < READYSTATE_COMPLETE 
    DoEvents 
  Loop 
   
  Call makeList(ie) 
   
  ie.Quit 
   
End Sub 
 
Public Sub makeList(ObjIE As InternetExplorer) 
  Dim n As Long ' 全てのタグの通し番号 
  Dim r As Long ' 指定したタグの通し番号 
  Dim Doc As HTMLDocument ' htmlドキュメント 
  Dim ObjTD As IHTMLElementCollection 
  Dim ObjTag As Object 
  n = 0 
  r = 0 
  Sheets("sheet1").Select 
  Cells.ClearContents 
   
  Cells.NumberFormatLocal = "G/標準" 
  Set Doc = ObjIE.Document 
  ' 
  '  For n = 0 To Doc.all.Length - 1 
  '    With Doc.all(n) 
  '      Debug.Print ("!") 
  '      If .tagName = "H1" Then 
  '        Debug.Print ("hit!") 
  '        r = r + 1 
  '        Cells(r + 1, 1) = .tagName 
  '        Cells(r + 1, 2) = n 
  '        Cells(r + 1, 3) = r 
  '        Cells(r + 1, 4) = .innerText 
  '        MsgBox (.innerText) 
  '      End If 
  '    End With 
  '  Next 
   
  Set ObjTD = Doc.getElementsByTagName("h1") 
  Debug.Print (ObjTD.Length) 
  For Each ObjTag In ObjTD 
    r = r + 1 
    Cells(r, 1) = r 
    Cells(r, 2) = ObjTag.tagName 
    Cells(r, 3) = ObjTag.innerText 
  Next ObjTag 
   
   
   
  Cells.EntireColumn.AutoFit 
  Cells.EntireRow.AutoFit 
End Sub 

コメント

タイトルとURLをコピーしました