EUCからUnicodeに変換(Excel VBA編)

XMLHTTPを使うと、Excel VBAからでも任意のURLからデータを取得できる。
(とりあえずIEコンポーネントの一部なのでIEカテゴリにしてみる)


問題になるのは、XMLHTTPでHTMLをダウンロードした時に、文字コードがそのままでは正しくExcel VBAでは扱えない点。
Excel VBAで扱う文字列型はUnicodeであり、Unicode以外の文字列を扱うには工夫(というか自作)が必要。それでもExcel VBAには変換を行う最低限のローレベル関数が用意されているので何とかなる。


今回ヤフオクの検索データをExcelシートにしたくて ヤフオク検索→Excelシートに転記 するスクリプトを書いてみたのでついでに副産品のEUCUnicode変換サブルーチンを紹介する。(ヤフオクEUCを使ってるのだ)


XMLHTTPでダウンロードしたデータは、どうやらダウンロードしたそのものが入っており、何も加工されていない。サーバがEUCで送ってくればEUCのマルチバイト文字列がそのままresponseBodyに格納される。実は、画像データなどバイナリデータでさえとってくることができる。


しかし、Excel VBAのString型はUnicodeなので、そのままresponseBodyをString型の変数に代入しても文字化けしていて正しく処理することができない。


Excel VBAでは、文字列をバイト単位(Unicodeでなくマルチバイトとして)で処理する関数が用意されている。ヘルプでも補足程度でしか触れられていないので最近の若いプログラマは知らない人もいるかもしれないが、基本的のほとんどの文字列処理関数は関数名の最後に"B"を追加するとバイト単位の処理を行う関数になる。
例えば、Len() は通常Unicode単位の文字数を返すが、LenB() を使うと、文字列をマルチバイトとしてカウントした場合の文字数(バイト数)を返す。他にもバリエーションとして、LeftB()、RightB()、MidB()など通常必要となる関数にはバイト版が用意されている。


さて、XMLHTTPでEUCエンコードの文字列を受け取った時、どうするか。
以下の流れでEUC文字列をExcel VBAで扱えるString型(Unicode)に変換できる。

(1)EUC文字列をString型変数に代入する。(この時点では文字化けしている)
(2)String型変数を1バイトずつ走査し、EUCシフトJIS変換を行う。
(3)StrConv()を使って、シフトJIS文字列をUnicode文字列に変換する。


サンプルコード。
ConvertEucToUnicode()の呼び出しで、引数にEUC文字列が入ったString型変数を渡すと、Unicode変換後の文字列を返す。

Function ConvertEucToUnicode(srcEuc As String) As String

Dim c1 As Long, c As Long
Dim i As Long, m As Long
Dim dstSJis As String
Dim SS2detected As Boolean

m = LenB(srcEuc)

c1 = 0
dstSJis = ""

i = 1
Do While i <= m
c = AscB(MidB$(srcEuc, i, 1))
If c1 <> 0 Then
' 2nd byte of the EUC(J) kanji
If c1 < &HA1 Or c1 > &HF4 Or c < &HA1 Or c = &HFF Then
' This is an invalid EUC(J) sequence.
Else
dstSJis = dstSJis + ConvertJisToShiftJis(c1 And &H7F, c And &H7F)
End If
c1 = 0
Else
If c >= &H20 And c < &H7F Then
' 7bit ASCII
dstSJis = dstSJis + ChrB$(c)
SS2detected = False
Else
If SS2detected Then
If c > &HA0 And c < &HE0 Then
' 1-byte Kana
dstSJis = dstSJis + ChrB$(c)
Else
' This is an invalid EUC(J) sequence.
End If
SS2detected = False
Else
If c < &H20 Then
' control codes
dstSJis = dstSJis + ChrB$(c)
Else
If c > &HA0 And c < &HFF Then
' 1st byte of the EUC(J) kanji
c1 = c
Else
If c = &H8E Then
' EUC(J) SS2 (Single Shift 2) for 1-byte Kana
SS2detected = True
Else
' This is an invalid EUC(J) sequence.
End If
End If
End If
End If
End If
End If
i = i + 1
Loop

' Convert the shift-JIS string to the Unicode
ConvertEucToUnicode = StrConv(dstSJis, vbUnicode)

End Function

Function ConvertJisToShiftJis(ByVal jis1 As Long, ByVal jis2 As Long) As String

If jis1 < &H21 Or jis1 > &H7E Or jis2 < &H21 Or jis2 > &H7E Then
ConvertJisToShiftJis = ""
Exit Function
End If

jis1 = jis1 - &H21
If jis1 Mod 2 = 1 Then
jis2 = jis2 + (&H7F - &H21)
End If
jis1 = Int(jis1 / 2) + &H81
If jis1 > &H9F Then
jis1 = jis1 + (&HE0 - &HA0)
End If
jis2 = jis2 + (&H40 - &H21)
If jis2 > &H7E Then
jis2 = jis2 + 1
End If

ConvertJisToShiftJis = ChrB$(jis1) + ChrB$(jis2)

End Function

なお変換優先でエラー処理(EUCとしてありえないバイトシーケンス)については無視するようにしている。