スクレイピング

【EXCEL VBA】　Excelで資産管理しよう！スクレイピングで投信基準価格を取得！ Webサイトのデータを取得　MSXMLを解説します　IEとMSXMLの速度比較　ディベロッパーツール使い方

【EXCEL VBA】　スクレイピング　Excelで資産管理しよう！　投信基準価格を取得！ MSXML版でWebサイトのデータを取得します　IEとMSXML速度比較　HTMLディベロッパーツール使い方

スクレイピングの基礎を習得しましょう！Excel＆VBAの基礎が出来ている人を対象にしています繰り返し処置、オブジェクト・コレクション等の理解が必要ですHTMLの知識があれば、より理解が深まると思います！**タイムテーブル**0:00　はじめに2:10　MSXMLとは…2:26　MSXMLライブラリ追加2:47　...

WEBデータの取得方法

MSXMLとは…

Microsoftが作ったXML (Extensible Markup Language)
XML とは、データを構造化して記述するためのマークアップ言語
HTMLのように、タグを使ってデータの意味や構造を定義する

Excel VBAのMSXML（Microsoft XML）ライブラリは、XMLデータの操作やWebサービスとの通信を行うための強力なツールです。MSXMLライブラリを使用することで、Excelから直接インターネット上のリソースにアクセスし、XMLデータの読み書きや解析を行うことができます。

はじめてのpythonとエクセルVBA入門
Excel VBAのMSXML（Microsoft XML）ライブラリ：XMLデータの処理とWebサービスの活用
https://python-vba.com/excel-vba-msxmlmicrosoft-xml/#google_vignette

MSXMLを使うために、ライブラリーの参照設定が必要です

MSXMLのオブジェクトを作成

Microsoft　XML, v6.0を参照設定する

あるいは

参照設定を使わない場合…

URL情報をGET

リクエスト送信

読込に時間がかかるので、読み込み完了まで待機

ReadyState定数

ここまでは、すべて同じ

終了処理

HTMLの検証

WebページのHTML・CSSを確認

[右クリック] →[検証]

Elememt□をクリック→参照したい箇所□をクリック→対象HTMLがハイライトされる緑

調べたい要素□を[右クリック] →[検証]→対象HTMLがハイライトされる

タイトル取得

～ページの読み込みからの続き

HTML文字列からHTLMドキュメントを生成する

Microsoft HTML Object Libraryを参照設定する

まとめて、これでもOK！

HTMLオブジェクトに書き出し

書き出しは、innerTextではなく、innerHTMLです！
これを間違えて、30分ぐらい悩んでました°(°´ᯅ`°)°｡

要素の取り出し

コレクションは複数形に！　getElementsです

オブジェクト・コレクション・Object変数については、こちらを見てね！
ForEachについても…

【EXCEL VBA】シートの追加　オブジェクト・コレクションとは…、オブジェクト変数について、For Each文、On Error…等すぐに役立つ　VBA　　＜世界一わかりやすいマクロ徹底解説＞

EXCEL　VBA中級編です。できるだけ、わかりやすく・詳しく・丁寧に解説しています。シートを追加します。実務では必須の知識です。ぜひ習得しましょう！シートの追加・ブックの追加①今回は、シートの追加・シート名変更です。オブジェクト、コレクション、オブジェクト変数についても学びます。これからプログラムを始め...

インデックス番号

インデックス番号は０から始まる
ｈ１タグは、多分１つしかないので、１番目＝インデックス番号０を指定する

データ取得プロパティと取得内容

Codeと指定するのは、
WorkSheets(“シート名”)とするのと同じ
シート名を変更しても、
プログラムの変更が不要です

要素の個数

ｈ２は、インデックス番号0，1，2，3　の４つ

要素の取り出し

For　Eachで要素を１つずつなくなるまでObject変数objに取り出す

繰り返し処理については、こちらを見てね！

【EXCEL　VBA】初級～応用編　繰り返し処理どれ選ぶ？　ForNext・ForEach・DoLoop・ExitFor、ExitDo・While/Until・無限ループとは…・条件式をどこに置く？

【EXCELVBA】＜For～Next　etc＞初級～応用編　繰り返し処理どれ選ぶ？　場合に場合に応じて繰り返し処理を使い分けましょう！！0:00はじめに0:33　ForNextステートメント5:06　ForEachステートメント5:48　オブジェクト・コレクションとは…7:27　ForEachをForNex...

終了処理

リストタグ

～HTMLオブジェクトに書き出しまでは同じ

親子関係

HTMLを見ると、家賃・管理費の上にliタグ、その上にulタグがある
親ulタグ→子liタグ
親タグから探って行こう！

親ulタグの個数

ulタグの表示

改行を削除
Replace(“文字列”, 改行コード定数, “”)

どうやらul(5)に物件情報があるらしい！？
ul(5)の内容

子liタグの個数

たくさんあるulの中で欲しいのは、ul(5)だけ！
ul(5)だけをオブジェクト変数に取り出す

objElement　←ul(5)だけ

liタグの表示

obj←ul(5)の中のliのひとつ

３件ごとに家賃と管理費があるね！
１件ずつ見て行こう！

objprice←li(0)

ｓｐａｎ・ｄｄタグ

spanは１つだけなので、ForEachなしで、
objPrice.getElementsByTagName(“span”)(0).innerText
等としてもOK!

全件取得

３件ごとに要素の取り出し
インデックス番号を３でわった余りが、０のときだけ、
家賃と管理費を取り出す

i Mod 3 = 0

家賃と管理費をすべて取得できた！

【EXCEL　VBA】初級～応用編　条件分岐なに使う？　IF文・ElseIF文・SelectCase文・Boolean型・Rnd関数・InputBox関数・InputBoxメソッド

【EXCELVBA】初級～応用編　条件分岐なに使う？　場合に応じて条件分岐を使い分けましょう！！0:00はじめに0:20　IF文1:00　InputBox関数1:10　InputBoxメソッド2:05　Boolean型3:30　１行でIF文4:55　ElseIF文6:25　入れ子のIF文6:55　Select...

テーブル

検索

Ctrl+F→table

ｔｒ→ｔｄ→div

ｔｒタグ

ｔｒの下にｔｄがあるので、次はｔｄを見てみよう！

ｔｄタグ

１件分のテーブル情報が取り出せた！

divタグ

１件分の家賃と管理費を取り出せた！

親子孫関係

ｔｒの下にｔｄがあり、ｔｄの下にdivがあり、入れ子になっています
親・子・孫の関係です

HTMLが入れ子の構造になっているので、
VBAでも同様に入れ子のForEach構造にして、一気に取得できます

全テーブル取得

Youtubeでは、３重のループにしていましたが、
一番外にtableのループも加えなければいけないのかもしれません！？
tableも加え、４重のループにしました

・各オブジェクト変数

・４重のループ

【EXCEL VBA】 VBA次の一歩　マクロで金運アップ！　入れ子のFor　Next・条件分岐・シートをアクティブに・表示位置の制御・罫線　等　VBA　中級編＜世界一わかりやすいマクロ徹底解説＞

EXCEL　VBA中級編です。むずかしい言葉は使わず、やさしく詳しく丁寧に解説しています。フローチャートからプログラムを作成していきます。今回は帳票作成の基本プログラムです。これを習得して、ぜひ実務に生かしてください。これからプログラムを始めたい方、VBAに一度挫折した方も挑戦してみてください。一緒にやってみてく...

赤枠１件（１テーブル）のデータ

ソースコード

Sub スクレイピングタイトル取得()
'MSXML版
    '
    '**設定**
    
    'MSXMLのオブジェクトを作成
    '参照設定　必要
    'Microsoft　XML, v6.0
    
    'オブジェクトを作成し､変数にセットします
    Dim xmlHttp As MSXML2.XMLHTTP60
    Set xmlHttp = New MSXML2.XMLHTTP60
    'あるいは
    'Dim xmlHttp As New MSXML2.XMLHTTP60
    
    'あるいは、参照設定を使わない場合
    'Set xmlHttp = CreateObject("MSXML2.XMLHTTP.6.0")
         
    '**処理**

    '指定のURLをGET
    Dim url As String
    url = "https://　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　"
    
    xmlHttp.Open "GET", url
      
    'リクエスト送信
    
    xmlHttp.send
    
     'ページの読み込みが完了するまで待つ （READYSTATE_COMPLETE：4）
     Do While xmlHttp.readyState <> 4     'READYSTATE_COMPLETE
        DoEvents
    Loop
    
    'HTML文字列からHTLMドキュメントを生成する
    '参照設定　必要
    'Microsoft HTML Object Library
     
    'HTMLドキュメント作成
　　Dim objHtml As HTMLDocument
　　Set objHtml = New HTMLDocument
    ’Dim objHtml As New HTMLDocument
     
     'レスポンスのテキストをHTMLオブジェクトに書き出し
    objHtml.body.innerHTML = xmlHttp.responseText
    'objHtml.write xmlHttp.responseText
  
   'h1タグの取り出し
    Dim title As String
    title = objHtml.getElementsByTagName("h1")(0).innerText
    
     'シートクリア
    Code.Cells.Clear
    
    'タイトル表示
    Code.Cells(1, 1) = "h1"
    Code.Cells(1, 2) = "0"
    Code.Cells(1, 3) = title
             
    'h2タグの個数
    MsgBox "h2　" & objHtml.getElementsByTagName("h2").Length
    
    'h2タグをObject変数に代入
    Dim i As Long, Gyo As Long
    i = 0: Gyo = 2
    Dim obj As Object
    For Each obj In objHtml.getElementsByTagName("h2")
       Code.Cells(Gyo, 1) = "h2"
       Code.Cells(Gyo, 2) = i
       Code.Cells(Gyo, 3) = obj.innerText
       Gyo = Gyo + 1
        i = i + 1
    Next obj
    
    'For Each→ForNext
    Set obj = objHtml.getElementsByTagName("h2")
    For i = 0 To obj.Length - 1
        Code.Cells(Gyo, 1) = "h2"
       Code.Cells(Gyo, 2) = i
       Code.Cells(Gyo, 3) = obj(i).innerText
       Gyo = Gyo + 1
    Next i
    
    '**終了処理**
    
    'オブジェクト解放
    Set xmlHttp = Nothing
    Set objHtml = Nothing
    Set obj = Nothing
    
End Sub

Sub スクレイピングul取得()
'MSXML版
    '
    '**設定**
    
    'MSXMLのオブジェクトを作成
    '参照設定　必要
    'Microsoft　XML, v6.0
    Dim xmlHttp As MSXML2.XMLHTTP60
    Set xmlHttp = New MSXML2.XMLHTTP60
    'あるいは
    'Set xmlHttp = CreateObject("MSXML2.XMLHTTP.6.0")
         
    '**処理**

    '指定のURLを開く
    Dim url As String
    url = "https://　　　　"
    xmlHttp.Open "GET", url
      
    'リクエスト送信
    xmlHttp.send
    
     'ページの読み込みが完了するまで待つ   （READYSTATE_COMPLETE：4）
    Do While xmlHttp.readyState <> 4     'READYSTATE_COMPLETE
        DoEvents
    Loop
    
    'HTML文字列からHTLMドキュメントを生成する
    '参照設定　必要
    'Microsoft HTML Object Library
     
    'HTMLドキュメントオブジェクト作成
    Dim objHtml As HTMLDocument
    Set objHtml = New HTMLDocument
     'Dim objHtml As New HTMLDocument
     
    'レスポンスのテキストをHTMLオブジェクトに書き出し
    objHtml.body.innerHTML = xmlHttp.responseText
    'objHtml.write xmlHttp.responseText
    
     'シートクリア
    Code.Cells.Clear
    Code.Cells(1, 1) = "コード"
    Code.Cells(1, 2) = "No."
    Code.Cells(1, 3) = "innerHTML"
    Code.Cells(1, 4) = "innerText"
    Code.Cells(1, 5) = "outerHTML"
 
        
    Dim i As Long, Gyo As Long, Retu As Long
    i = 0: Gyo = 2
     
    'ulタグの個数
    Debug.Print "ul " & objHtml.getElementsByTagName("ul").Length
    
    'ulタグの表示
    'レスポンステキストのulタグを１つずつObject変数に取り出す
    Dim obj As Object
    For Each obj In objHtml.getElementsByTagName("ul")
        Code.Cells(Gyo, 1) = "ul"
        Code.Cells(Gyo, 2) = i                          'インデックス番号
        Code.Cells(Gyo, 3) = Replace(obj.innerHTML, vbLf, "")
        Code.Cells(Gyo, 4) = Replace(obj.innerText, vbLf, "")
        Code.Cells(Gyo, 5) = Replace(obj.outerHTML, vbLf, "")
        Gyo = Gyo + 1
        i = i + 1
    Next obj
    
    'ul(5)の中に　物件情報がある
    Dim objElement As Object
    Set objElement = objHtml.getElementsByTagName("ul")(5)
    
    'ul(5)の中のliタグの個数
    Debug.Print "li " & objElement.getElementsByTagName("li").Length
    
    i = 0
    
    'liタグの表示
    For Each obj In objElement.getElementsByTagName("li")
        Code.Cells(Gyo, 1) = "li"
        Code.Cells(Gyo, 2) = i
        Code.Cells(Gyo, 3) = Replace(obj.innerHTML, vbLf, "")
        Code.Cells(Gyo, 4) = Replace(obj.innerText, vbLf, "")
        Code.Cells(Gyo, 5) = Replace(obj.outerHTML, vbLf, "")
        Gyo = Gyo + 1
        i = i + 1
    Next obj
 
    'objElementのli(０)をobjPriceに代入
    Dim objPrice As Object
    Set objPrice = objElement.getElementsByTagName("li")(0)
    
    'li(0)の中のspanタグの個数
    Debug.Print "span " & objPrice.getElementsByTagName("span").Length
        
    'spanタグの表示
    i = 0
    For Each obj In objPrice.getElementsByTagName("span")
        Code.Cells(Gyo, 1) = "span"
        Code.Cells(Gyo, 2) = i
        Code.Cells(Gyo, 3) = Replace(obj.innerHTML, vbLf, "")
        Code.Cells(Gyo, 4) = Replace(obj.innerText, vbLf, "")
        Code.Cells(Gyo, 5) = Replace(obj.outerHTML, vbLf, "")
        Gyo = Gyo + 1
        i = i + 1
    Next obj
    
    Debug.Print objPrice.getElementsByTagName("span")(0).innerText
        
    'li(0)の中のddタグの個数
    Debug.Print "dd " & objPrice.getElementsByTagName("dd").Length
    
    'ddタグの表示
    i = 0
    For Each obj In objPrice.getElementsByTagName("dd")
        Code.Cells(Gyo, 1) = "dd"
        Code.Cells(Gyo, 2) = i
        Code.Cells(Gyo, 3) = Replace(obj.innerHTML, vbLf, "")
        Code.Cells(Gyo, 4) = Replace(obj.innerText, vbLf, "")
        Code.Cells(Gyo, 5) = Replace(obj.outerHTML, vbLf, "")
        Gyo = Gyo + 1
        i = i + 1
    Next obj
    
    '**終了処理**
    'オブジェクト解放

    Set xmlHttp = Nothing
    Set objHtml = Nothing
    Set objElement = Nothing
    Set objPrice = Nothing
    Set obj = Nothing
    
End Sub

Sub スクレイピング家賃取得()
'MSXML版
    '
    '**設定**
    
    'MSXMLのオブジェクトを作成
    '参照設定　必要
    'Microsoft　XML, v6.0
    Dim xmlHttp As MSXML2.XMLHTTP60
    Set xmlHttp = New MSXML2.XMLHTTP60
    'あるいは
    'Set xmlHttp = CreateObject("MSXML2.XMLHTTP.6.0")
         
    '**処理**

    '指定のURLを開く
    Dim url As String
    url = "https://　　"
    xmlHttp.Open "GET", url
      
    'リクエスト送信
    xmlHttp.send
    
     'ページの読み込みが完了するまで待つ   （READYSTATE_COMPLETE：4）
    Do While xmlHttp.readyState <> 4     'READYSTATE_COMPLETE
        DoEvents
    Loop
    
    'HTML文字列からHTLMドキュメントを生成する
    '参照設定　必要
    'Microsoft HTML Object Library
     
    'HTMLドキュメントオブジェクト作成
    Dim objHtml As HTMLDocument
    Set objHtml = New HTMLDocument
     'Dim objHtml As New HTMLDocument
     
    'レスポンスのテキストをHTMLオブジェクトに書き出し
    objHtml.body.innerHTML = xmlHttp.responseText
    'objHtml.write xmlHttp.responseText
    
     'シートクリア
    Code.Cells.Clear
    Code.Cells(1, 1) = "コード"
    Code.Cells(1, 2) = "No."
    Code.Cells(1, 3) = "innerHTML"
    Code.Cells(1, 4) = "innerText"
    Code.Cells(1, 5) = "outerHTML"
        
    Dim i As Long, Gyo As Long, Retu As Long
    i = 0: Gyo = 2
     
    'ulタグの個数
    'Debug.Print objHtml.getElementsByTagName("ul").Length
    
    'ulタグの表示
    Dim obj As Object
    'レスポンステキストのulタグをObject変数に代入
    For Each obj In objHtml.getElementsByTagName("ul")
        Code.Cells(Gyo, 1) = "ul"
        Code.Cells(Gyo, 2) = i
        Code.Cells(Gyo, 3) = Replace(obj.innerHTML, vbLf, "")
        Code.Cells(Gyo, 4) = Replace(obj.innerText, vbLf, "")
        Code.Cells(Gyo, 5) = Replace(obj.outerHTML, vbLf, "")
        Gyo = Gyo + 1
        i = i + 1
    Next obj
    
    'ul(5)の中に　物件情報がある　
    Dim objElement As Object
    Set objElement = objHtml.getElementsByTagName("ul")(5)

    'ul(5)の中のliタグ
    'Debug.Print objElement.getElementsByTagName("li").Length
    
    i = 0
    'liタグの表示　"ul"5 li-0,3,6,9…
    For Each obj In objElement.getElementsByTagName("li")
       If i Mod 3 = 0 Then
            Code.Cells(Gyo, 1) = "span　dd"
            Code.Cells(Gyo, 2) = i
            Code.Cells(Gyo, 3) = obj.getElementsByTagName("span")(0).innerText
            Code.Cells(Gyo, 4) = obj.getElementsByTagName("dd")(0).innerText
            Gyo = Gyo + 1
        End If
        i = i + 1
    Next obj
    
    '**終了処理**
    'オブジェクト解放

    Set xmlHttp = Nothing
    Set objHtml = Nothing
    Set objElement = Nothing
    Set obj = Nothing
    
End Sub

Sub スクレイピングtable取得()
'MSXML版
    '
    '**設定**
    
    'MSXMLのオブジェクトを作成
    '参照設定　必要
    'Microsoft　XML, v6.0
    Dim xmlHttp As MSXML2.XMLHTTP60
    Set xmlHttp = New MSXML2.XMLHTTP60
    'あるいは
    'Set xmlHttp = CreateObject("MSXML2.XMLHTTP.6.0")
         
    '**処理**

    '指定のURLを開く
    Dim url As String
    url = "https://　　　　"
    xmlHttp.Open "GET", url
      
    'リクエスト送信
    xmlHttp.send
    
     'ページの読み込みが完了するまで待つ   （READYSTATE_COMPLETE：4）
    Do While xmlHttp.readyState <> 4     'READYSTATE_COMPLETE
        DoEvents
    Loop
    
    'HTML文字列からHTLMドキュメントを生成する
    '参照設定　必要
    'Microsoft HTML Object Library
     
    'HTMLドキュメントオブジェクト作成
    Dim objHtml As HTMLDocument
    Set objHtml = New HTMLDocument
     'Dim objHtml As New HTMLDocument
     
    'レスポンスのテキストをHTMLオブジェクトに書き出し
    objHtml.body.innerHTML = xmlHttp.responseText
    'objHtml.write xmlHttp.responseText
    
     'シートクリア　&　見出し
    Code.Cells.Clear
    Code.Cells(1, 1) = "コード"
    Code.Cells(1, 2) = "No."
    Code.Cells(1, 3) = "innerHTML"
    Code.Cells(1, 4) = "innerText"
    Code.Cells(1, 5) = "outerHTML"
    
    Dim i As Long, Gyo As Long, Retu As Long
     i = 0: Gyo = 2
     
    'trタグの個数
    Dim obj As Object
    Debug.Print "tr　" & objHtml.getElementsByTagName("tr").Length
    
    'trタグの表示
    For Each obj In objHtml.getElementsByTagName("tr")
        Code.Cells(Gyo, 1) = "tr"
        Code.Cells(Gyo, 2) = i
        Code.Cells(Gyo, 3) = Replace(obj.innerHTML, vbLf, "")
        Code.Cells(Gyo, 4) = Replace(obj.innerText, vbLf, "")
        Code.Cells(Gyo, 5) = Replace(obj.outerHTML, vbLf, "")
        Gyo = Gyo + 1
        i = i + 1
    Next
    
    'trタグをObject変数に代入
    Dim objElement As Object
    Set objElement = objHtml.getElementsByTagName("tr")(0)
    'tｄタグの個数
    Debug.Print "td　" & objElement.getElementsByTagName("td").Length
    
    'tdタグの表示
    i = 0
    For Each obj In objElement.getElementsByTagName("td")
        Code.Cells(Gyo, 1) = "td"
        Code.Cells(Gyo, 2) = i
        Code.Cells(Gyo, 3) = Replace(obj.innerHTML, vbLf, "")
        Code.Cells(Gyo, 4) = Replace(obj.innerText, vbLf, "")
        Code.Cells(Gyo, 5) = Replace(obj.outerHTML, vbLf, "")
        Gyo = Gyo + 1
        i = i + 1
    Next
    
    'td(０)をObject変数に代入
    Dim objdiv As Object
    Set objdiv = objElement.getElementsByTagName("td")(0)

    'divタグの個数
    Debug.Print "div　" & objdiv.getElementsByTagName("div").Length
    
    'divタグの表示
    i = 0
    For Each obj In objdiv.getElementsByTagName("div")
        Code.Cells(Gyo, 1) = "div"
        Code.Cells(Gyo, 2) = i
        Code.Cells(Gyo, 3) = Replace(obj.innerHTML, vbLf, "")
        Code.Cells(Gyo, 4) = Replace(obj.innerText, vbLf, "")
        Code.Cells(Gyo, 5) = Replace(obj.outerHTML, vbLf, "")
        Gyo = Gyo + 1
        i = i + 1
    Next
    
    '**終了処理**
    'オブジェクト解放

    Set xmlHttp = Nothing
    Set objHtml = Nothing
    Set objElement = Nothing
　　Set objdiv = Nothing
    Set obj = Nothing
    
End Sub

Sub スクレイピング全table取得()
'MSXML版
    '
    '**設定**
    
    'MSXMLのオブジェクトを作成
    '参照設定　必要
    'Microsoft　XML, v6.0
    Dim xmlHttp As MSXML2.XMLHTTP60
    Set xmlHttp = New MSXML2.XMLHTTP60
    'あるいは
    'Set xmlHttp = CreateObject("MSXML2.XMLHTTP.6.0")
         
    '**処理**

    '指定のURLを開く
    Dim url As String
    url = "https://　　"
    xmlHttp.Open "GET", url
      
    'リクエスト送信
    xmlHttp.send
    
     'ページの読み込みが完了するまで待つ   （READYSTATE_COMPLETE：4）
    Do While xmlHttp.readyState <> 4     'READYSTATE_COMPLETE
        DoEvents
    Loop
    
    'HTML文字列からHTLMドキュメントを生成する
    '参照設定　必要
    'Microsoft HTML Object Library
     
    'HTMLドキュメントオブジェクト作成
    Dim objHtml As HTMLDocument
    Set objHtml = New HTMLDocument
     'Dim objHtml As New HTMLDocument
     
    'レスポンスのテキストをHTMLオブジェクトに書き出し
    objHtml.body.innerHTML = xmlHttp.responseText
    'objHtml.write xmlHttp.responseText
    
     'シートクリア　&　見出し
    Code.Cells.Clear
    Code.Cells(1, 1) = "コード"
    Code.Cells(1, 2) = "No."
    Code.Cells(1, 3) = "innerHTML"
    Code.Cells(1, 4) = "innerText"
    Code.Cells(1, 5) = "outerHTML"
    
    
    Dim objtable As Object   'tableのObject変数
    Dim objtr As Object        'trのObject変数
    Dim objtd As Object       'tdのObject変数
    Dim objdiv As Object      'divのObject変数
    
    Dim i As Long, Gyo As Long
     i = 1: Gyo = 2
        
    'tableの表示
    For Each objtable In objHtml.getElementsByTagName("table")
   
        For Each objtr In objtable.getElementsByTagName("tr")
            
            For Each objtd In objtr.getElementsByTagName("td")
                
                For Each objdiv In objtd.getElementsByTagName("div")
                
                    Code.Cells(Gyo, 1) = "table tr td div"
                    Code.Cells(Gyo, 2) = i
                    Code.Cells(Gyo, 3) = Replace(objdiv.innerHTML, vbLf, "")
                    Code.Cells(Gyo, 4) = Replace(objdiv.innerText, vbLf, "")
                    Code.Cells(Gyo, 5) = Replace(objdiv.outerHTML, vbLf, "")
                    Gyo = Gyo + 1
                   
                Next objdiv
                
            Next objtd
             
        Next objtr
        i = i + 1        'テーブルの数
    Next objtable
    
    '**終了処理**
    'オブジェクト解放

    Set xmlHttp = Nothing
    Set objHtml = Nothing
    Set objtable = Nothing
    Set objtr = Nothing
    Set objtd = Nothing
    Set objdiv = Nothing
    
End Sub