（例）HPのタイトルからHＴMLを取得し、テキストへ出力する

あらかじめ開いているHPのタイトルから、
HTMLを取得して、
テキストファイルに出力する。


＜サンプル＞
Public Sub 実行()
'あらかじめIEでホームページを開いておく
    Dim objIE As InternetExplorer
    Set objIE = getIE("Google")  '開いているHPを指定
    objIE.Visible = True '見えるようにする
   
    '1:IEを起動する
    Do While objIE.Busy Or objIE.readyState < READYSTATE_COMPLETE
        DoEvents
    Loop
   
    'FunctionでgetHTMLStringを呼び出し、HTMLの文字列を取得する
    Dim HTMLString As String
    HTMLString = HTML取得(objIE)
   
    '2:出力開始
    Dim FileName As String
   
    FileName = ThisWorkbook.Path & "\HTML_" & Format(Now, "YYYYMMDDHHmmSS") & ".txt"
   
    '変数FileN0にファイル番号0を代入
    Dim FileN0 As Integer
    FileN0 = FreeFile()
   
    'テキストファイル作成（ファイル番号0）
    Open FileName For Output As #FileN0
   
    'ファイルに文字"test"を書き込む
    Print #FileN0, HTMLString
    'テキストファイルとの接続をきる
    Close #FileN0

    MsgBox "出力しました"
End Sub

Private Function getIE(arg_title As String) As InternetExplorer
'開いているIEの中でタイトルと一致するHPを探す
    Dim ie As InternetExplorer
    Dim sh As Object
    Dim win As Object
    Dim document_title As String
   
    Set sh = CreateObject("Shell.Application")
   
    For Each win In sh.Windows
        document_title = ""  '開いているIEのタイトルを格納した変数をクリア
        On Error Resume Next
        document_title = win.document.Title  '開いているIEのタイトルを格納
        On Error GoTo 0
       
        If InStr(document_title, arg_title) > 0 Then
        'タイトルと引数（検索ワード）とが一致する
            Set ie = win
            Exit For  '一致したらループから抜ける
        End If
    Next
   
    Set getIE = ie
End Function

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