VBAでEUC-JPのHTMLソースを取得しShift-JISにしたい

質問

こんにちは。
現在
１．Msxmlで任意のHTMLソースを取得
（ただこれがEUCで、エクセル上だと文字化けする）
２．それをShift-JISにエンコードして、のちのちExcel表にする）
というコードをExcelVBAで描いています。

ソースの取得はできるのですが、
EUCのサイトのため漢字が文字化けします。
エンコードしようと思ってもできません。
ADODB.Streamというものを使おうとしています。

宜しくお願い致します。

Dim xmlHttp

Set xmlHttp = CreateObject("Msxml2.XMLHTTP")

xmlHttp.Open "GET", url, False
xmlHttp.send

Set in_strm = CreateObject("ADODB.Stream")
Set out_strm = CreateObject("ADODB.Stream")

in_strm.Charset = "EUC-JP"
in_strm.Type = adTypeText

out_strm.Charset = "Shift_JIS"
out_strm.Type = adTypeText

in_strm.Open
out_strm.Open

m_byte1 = xmlHttp.responseText
in_strm.WriteText m_byte1
in_strm.Position = 0

in_strm.CopyTo out_strm

out_strm.Position = 0

m_string2 = out_strm.ReadText(adReadAll)

MsgBox m_string2 'ここで正しいものが表示される予定・・・

in_strm.Close
out_strm.Close

Set in_strm = Nothing
Set out_strm = Nothing

回答No.2

xls88 · ベストアンサー

文字化けしなければ良いですか？

Sub test1()
Dim xmlHttp
Dim URL As String
Dim in_strm
Dim m_string2

URL = "http://www.mapfan.com/"
Set xmlHttp = CreateObject("Msxml2.XMLHTTP")

xmlHttp.Open "GET", URL, False
xmlHttp.send

Set in_strm = CreateObject("ADODB.Stream")
in_strm.Open
in_strm.Position = 0
in_strm.Type = 1 'adTypeBinary
in_strm.Write xmlHttp.responseBody

in_strm.Position = 0
in_strm.Type = 2 'adTypeText
in_strm.Charset = "EUC-JP"
'in_strm.Charset = "_autodetect" '自動判別でも可

m_string2 = in_strm.ReadText
MsgBox m_string2

in_strm.Close
Set in_strm = Nothing
End Sub

お礼

できましたー！！！！
ありがとうございます。感動です。

回答No.3

xls88

文字コードの変換は、下記スレッドで
KenKen_SPさんの回答が参考になるかも知れません。

VBAでUTF-8文字を読込、Excelに出力する方法
http://oshiete1.goo.ne.jp/qa1963113.html

お礼

ありがとうございます。
参考になりました。

回答No.1

kata_san

文字コードの変換を行うだけであれば、
http://www.kmonos.net/lib/
にある「GreenPad」というテキストエディタが、きちんと変換できますが？

お礼

ありがとうございます。
でも、マクロ中で文字コード変換を行いたいんです。