削除

WebページのTableをExcelへ保存削除

Message#2 2014年10月12日(日)06時59分
From: 管理人

今回は2桁表示がメインのようなので、tableタグの中から市町村コード部分だけを抽出しています。
以下で一度処理をご確認ください。

また、teble情報抽出についても併せてご確認ください。

【tableタグデータをピンポイントに抽出する】
http://www.vba-ie.net/element/table.html

Sub sample()

Dim objIE As InternetExplorer
Dim objTag As Object

'IEでサイトを表示
Call ieView(objIE, "http://www.tt.rim.or.jp/~ishato/tiri/code/kanto.htm")

r = 1

For Each objTag In objIE.document.getElementsByTagName("table")

For i = 0 To objTag.Rows.Length - 1

value = objTag.Rows(i).Cells(0).innerText

Cells(r, 1).NumberFormatLocal = "@"

Cells(r, 1) = CStr(objTag.Rows(i).Cells(0).innerText)
r = r + 1

Next i

Next

End Sub

Sub ieView(objIE As InternetExplorer, _
　　　　　 urlName As String, _
Optional viewFlg As Boolean = True, _
　　　　　 Optional ieTop As Integer = 0, _
Optional ieLeft As Integer = 0, _
Optional ieWidth As Integer = 600, _
Optional ieHeight As Integer = 800)

　'IEのオブジェクトを作成する
　Set objIE = CreateObject("InternetExplorer.Application")

'IEを表示・非表示
objIE.Visible = viewFlg

　objIE.Top = ieTop　'Y位置
　objIE.Left = ieLeft　'X位置
　objIE.Width = ieWidth　'幅
　objIE.Height = ieHeight　'高さ

'指定したURLのページを表示する
　objIE.Navigate urlName

'IEが完全表示されるまで待機
Call ieCheck(objIE)

End Sub

Sub ieCheck(objIE As InternetExplorer)

　Dim timeOut As Date

　timeOut = Now + TimeSerial(0, 0, 10)

　Do While objIE.Busy = True Or objIE.ReadyState <> 4
　　DoEvents
　　Sleep 100
　　If Now > timeOut Then
　　　objIE.Refresh
　　　timeOut = Now + TimeSerial(0, 0, 10)
　 End If
　Loop

　timeOut = Now + TimeSerial(0, 0, 10)

　Do Until objIE.document.ReadyState = "complete"
　　DoEvents
　　Sleep 100
　　If Now > timeOut Then
　　　objIE.Refresh
　　　timeOut = Now + TimeSerial(0, 0, 10)
　　End If
　Loop

End Sub

上のメッセージを削除します。
よければパスワードを入力し、削除ボタンをクリックしてください。