Sub GetRequestSimple1_revised()
    Dim url As String
    url = "http://www.exvba.com/ws/dombasic_shift_jis.html"

    Dim xh As New WinHttp.WinHttpRequest 'HTTPリクエストを制御するクラスのインスタンスを生成
    xh.Open "GET", url, False
    xh.send
    
    Dim sCode As String
    sCode = xh.Status
    If sCode <> 200 Then 'ステータスコードを調べる
        MsgBox "リクエストに失敗しました" & vbNewLine & sCode
    End If
    
    Dim sHead As String
    Dim sBody As String
    sHead = xh.GetAllResponseHeaders
'    sBody = xh.ResponseText
    sBody = StrConv(xh.responseBody, vbUnicode) 'ここを変更した
    
    Worksheets("response").Range("B1").Value = sHead
    Worksheets("response").Range("B2").Value = sBody
    
    Debug.Print xh.GetResponseHeader("Content-Length")
End Sub

Option Explicit

'概要:
'ADODB.Stream オブジェクトを使って文字化けを解消する

'必要なライブラリ:
'[1] Microsoft ActiveX Data Object x.x Library -> 文字コード変更のため(x.x の部分は一番大きいバージョンを選べばまず間違いなくOK)
'[2] Microsoft WinHTTP Services, version 5.1 -> HTTPリクエストをするため
'[3] Microsoft HTML Object Library -> コンテンツのDOMを解析するため

'以下の2つは、UTF8エンコードされたページ、Shift_JISエンコードされたページ
'後者は、このデモスクリプトの参照先として新たに作りました。ただし、ブラウザで見ると、文字化けするものと思います。
Const S_UTF8_URL As String = "http://www.exvba.com/ws/dombasic.html"
Const S_SHIFTJIS_URL As String = "http://www.exvba.com/ws/dombasic_shift_jis.html"

'まずは、以下の2つのプロシージャで感触を確かめてください。
Public Sub get_utf8_content()
    'utf8エンコードされたコンテンツを取得し、エクセルシートに出力してみます
    Dim url As String
    Dim response_body() As Byte '型に注意！ Byte型の配列です。
    response_body = get_body(S_UTF8_URL)
    
    'responseBody の文字コードを utf-8 とみなして処理し、最終的に出力します
    change_and_message "A", response_body, "utf-8" '明示的に変換後の文字コードを指定する場合。"utf-8"は一例。候補たる文字列は、レジストリの HKEY_CLASSES_ROOT\MIME\Database\Charset を参照のこと。
End Sub
Public Sub get_shift_jis_content()
    'shift_jisエンコードされたコンテンツを取得し、エクセルシートに出力してみます
    Dim url As String
    Dim response_body() As Byte '型に注意！ Byte型の配列です。
    response_body = get_body(S_SHIFTJIS_URL)
    
    'responseBody の文字コードを 自動判別して処理し、最終的に出力します
    change_and_message "B", response_body, "_autodetect" '文字コードを自動判別する場合
End Sub
Private Function get_body(url) As Byte() '型に注意！ Byte型の配列です。
    Dim xh As New WinHttp.WinHttpRequest
    xh.Open "GET", url, False
    xh.send
    
    Dim sCode As String
    sCode = xh.Status
    If sCode <> 200 Then
        MsgBox "リクエストに失敗しました" & vbNewLine & sCode
    End If
    get_body = xh.responseBody
End Function
Private Function change_and_message(data_column As String, response_body() As Byte, char_set As String) As String
    Dim msg1 As String, msg2 As String 'msgboxでの途中経過出力用
    
    msg1 = response_body 'Byte()を文字列に変換(msg1 as string だから)
    MsgBox msg1
    
    'Microsoft ActiveX Data Object x.x Library を使います
    'すごく乱暴に書くと、以下の流れ:
    'ADODB.Stream型のインスタンスについて
    '   Openする
    '   入力するデータにかかる設定をする
    '   データを流し込む
    '   出力するデータにかかる設定をする
    '   データを出力する
    '   Closeする
    Dim ado_stream As New ADODB.Stream
    ado_stream.Open 'Openする
    ado_stream.Position = 0 'すごく乱暴に書くとおまじない
    ado_stream.Type = 1 '受け取るデータの型を指定。 1:adTypeBinary(バイト型) 2:adTypetext(テキスト型)
    ado_stream.Write response_body 'データを流し込む
    
    ado_stream.Position = 0 'すごく乱暴に書くとおまじない。ときどき0でないことも。文字コードの話は深いのでこれ以上今は書けません。
    ado_stream.Type = 2 '出力するデータの型を指定。 2:adTypetext(テキスト型)
    ado_stream.charset = char_set '"_autodetect" とか "utf-8" とかを指定する部分。何が入るかはケースバイケース。
    
    msg2 = ado_stream.ReadText 'データを出力する
    ado_stream.Close 'Closeする
    
    MsgBox msg2
    
    Range(data_column & 1).Value = msg2
End Function

'ということで、本丸。shift_jisのウェブページを取得して解析してみる
Public Sub analyze_shift_jis_content()
    Dim url As String
    Dim response_body() As Byte '型に注意！ Byte型の配列です。
    Dim new_response_body As String
    response_body = get_body(S_SHIFTJIS_URL)
    new_response_body = change_encode(response_body, "_autodetect")
    analyze_response_body new_response_body
End Sub
Private Function change_encode(response_body() As Byte, char_set As String) As String
    Dim result_text As String
    Dim ado_stream As New ADODB.Stream
    ado_stream.Open
    ado_stream.Position = 0
    ado_stream.Type = adTypeBinary
    ado_stream.Write response_body
    
    ado_stream.Position = 0
    ado_stream.Type = adTypeText
    ado_stream.charset = char_set
    
    result_text = ado_stream.ReadText
    ado_stream.Close
    
    change_encode = result_text
End Function
Private Sub analyze_response_body(new_response_body As String)
    Dim oHTml As New MSHTML.HTMLDocument
    oHTml.body.innerHTML = new_response_body

    '所定のIDの要素を取得します
    Dim oH1 As MSHTML.HTMLHeadElement
    Set oH1 = oHTml.getElementById("h1_01")
    Debug.Print oH1.outerHTML
    Debug.Print oH1.innerHTML
    Debug.Print oH1.innerText
    
    '所定の要素の次の要素を取得します
    Debug.Print oH1.NextSibling.outerHTML
    Debug.Print oH1.NextSibling.innerHTML
    Debug.Print oH1.NextSibling.innerText
    
    'HTMLBody全体を取得します
    Dim oH As MSHTML.HTMLBody
    Set oH = oHTml.getElementsByTagName("body")(0)
    Debug.Print oH.outerHTML
    Debug.Print oH.innerHTML
    Debug.Print oH.innerText
    
    'HtmlBodyの子要素のうち4番目のものを取得します
    Debug.Print oH.ChildNodes(3).outerHTML
    Debug.Print oH.ChildNodes(3).innerHTML
    Debug.Print oH.ChildNodes(3).innerText
    
    'H2タグのついた要素すべてを順番に調べます
    Dim oH2 As MSHTML.HTMLHeadElement
    For Each oH2 In oHTml.getElementsByTagName("h2")
        Debug.Print oH2.outerHTML
        Debug.Print oH2.innerHTML
        Debug.Print oH2.innerText
    Next
End Sub

'    sBody = xh.ResponseText
    sBody = StrConv(xh.responseBody, vbUnicode) 'ここを変更した