指定したURLのHTMLを頭から256字抽出する | カメレオンのVBA

カメレオンのVBA

VBAの私的メモ書き



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