Public Sub 実行()
Dim objIE As InternetExplorer
Set objIE = CreateObject("InternetExplorer.Application")
objIE.Visible = True '見えるようにする
objIE.navigate "http://www.yahoo.co.jp/" 'URLを適宜入力する
'IEを起動する
Do While objIE.Busy Or objIE.readyState < READYSTATE_COMPLETE
DoEvents
Loop
'FunctionでgetHTMLStringを呼び出し、HTMLの文字列を取得する
Dim HTMLString As String
HTMLString = HTML取得(objIE)
'書き込み開始
ThisWorkbook.Activate
With Range("A1")
.Clear
.Value = Left(HTMLString, 256)
End With
End Sub
Private Function HTML取得(container As Object, Optional depth As Long = 0) As String
Dim ErrorInfo As String
Dim htdoc As HTMLDocument
'↓↓↓HTML文書取得時のエラーを無視する↓↓↓
On Error Resume Next
Set htdoc = container.document
If Err.Number <> 0 Then
'エラー情報を保持する
ErrorInfo = Trim(str(Err.Number)) & ":" & Err.Description
End If
On Error GoTo 0
'↑↑↑HTML文書取得時のエラーを無視する↑↑↑
Dim ret As String
ret = "-------------" & vbCrLf '区切り値作成
ret = ret & "[" & Trim(str(depth)) & "階層]" & vbCrLf
If Not htdoc Is Nothing Then
ret = ret & htdoc.Title & " | " & htdoc.Location & " (" & container.Name & ")" & vbCrLf
ret = ret & "-------------" & vbCrLf
ret = ret & htdoc.getElementsByTagName("HTML")(0).outerHTML & vbCrLf 'HTMLソース全体を取得
'フレームの数だけ繰り返す
Dim i As Integer
For i = 0 To htdoc.frames.Length - 1
ret = ret & HTML取得(htdoc.frames(i), depth + 1)
Next
Else
ret = ret & "-------------" & vbCrLf
ret = ret & ErrorInfo
End If
HTML取得 = ret
End Function