CSV形式でダウンロードしたデータの一部が文字化けしていて困ってるという相談を受けて、「読み込み時のエンコード指定の問題でしょｗ」と見てみると部分的にHTMLエンコードされている謎のCSV・・・。
これに対応すべく部分的なHTMLエンコード文字をデコードして置換するスクリプトを作ってみました。
いろいろ調べてもHTMLエンコードかと思いきやURLエンコードの記事だったりして目標にたどり着くのにちょっと時間がかかってしまいましたが以下を発見。
シンプルで分かりやすく、これだ！と思ったけどそのままでは使えなかったの修正して使わせていただきました。
この記事で紹介している内容
テストのような数値文字参照のHTMLエンコードされた文字列をデコード- 文字列の中から変換対象を探し出してデコード後の文字列に置換する関数
- ドラッグアンドドロップでCSVファイル内のHTMLエンコード文字列をデコードして置換するVBS
Excel用ユーザー定義関数
Function htmlDecode(strText As String) Dim regEx Dim matches Dim match Dim strHex, strUni As String 'よく使われるHTML特殊文字コードを置換 strText = Replace(strText, """, Chr(34)) '" strText = Replace(strText, "<", Chr(60)) '< strText = Replace(strText, ">", Chr(62)) '> strText = Replace(strText, "&", Chr(38)) '& strText = Replace(strText, " ", Chr(32)) ' (半角スペース) '正規表現オブジェクト準備 Set regEx = CreateObject("VBScript.RegExp") With regEx .Pattern = "&#x(.+?);" '抽出パターン .Global = True '全件マッチ：True／先頭マッチ：False End With Set matches = regEx.Execute(strText) '正規表現パターンにマッチした数だけ繰り返し置換 For Each match In matches strHex = CLng("&H" & match.SubMatches(0)) '16進数→10進数へ変換 strUni = ChrW(strHex) '10進数→マルチバイト文字へ変換 strText = Replace(strText, match.Value, strUni) '正規表現にマッチした箇所をマルチバイト文字列で置換 Next htmlDecode= strText End Function
CSVファイルのドラッグアンドドロップ用 VBScript
Charset（文字コード）や LineSeparator（改行コード） については扱うCSVファイルの種類によって適宜変更ください。
Set objArgs = WScript.Arguments 'コマンドライン引数が1つなら処理継続 If objArgs.Count = 1 Then 'FileSystemオブジェクト初期化 Set objFileSys = CreateObject("Scripting.FileSystemObject") 'ドロップされたファイルの拡張子を取得 filePath = objArgs(0) strExt = objFileSys.GetExtensionName(filePath) '拡張子がCSVなら処理継続 If strExt = "csv" Then 'ADODBオブジェクト初期化 Set stInput = CreateObject("ADODB.Stream") Set stOutput = CreateObject("ADODB.Stream") 'CSVインポート stInput.Type = 2 '1:バイナリ / 2:テキスト stInput.Charset = "UTF-8" '文字コード指定 stInput.Open stInput.LineSeparator = -1 'CR:13 / CRLF:-1 / LF:10 stInput.LoadFromFile filePath 'CSVファイルを読み込む 'CSVエクスポート設定 stOutput.Type = 2 stOutput.Charset = "UTF-8" stOutput.Open '1行ずつ読み込み → HTMLデコードを実行 → stOutputへ書き込み Do Until stInput.EOS strLine = stInput.ReadText(-2) '-1:全行読み込み / -2:1行ずつ読み込み strLine = htmlDecode(strLine) 'HTMLデコードを実行 stOutput.WriteText strLine, 1 '0:文字列のみ書き込み / 1:文字列+改行を書き込み Loop 'CSVファイルをエクスポート stOutput.SaveToFile filePath, 2 '1:なければ新規作成 / 2:上書き 'ADODBオブジェクトをクローズ stInput.Close stOutput.Close Set objArgs = Nothing Set objFileSys = Nothing msgbox "変換完了" Else 'CSV以外のファイルが渡された場合 msgbox "CSV形式のファイルをドラッグアンドドロップしてください。" End If Else 'ファイルが複数の時、アイコンをダブルクリックされた時 msgbox "複数のファイルが渡されました。1つずつドラッグアンドドロップしてください。" End If Function htmlDecode(strText) Dim regEx Dim matches Dim match Dim strHex Dim strUni 'よく使われるHTML特殊文字コードを置換 strText = Replace(strText, """, Chr(34)) '" strText = Replace(strText, "<", Chr(60)) '< strText = Replace(strText, ">", Chr(62)) '> strText = Replace(strText, "&", Chr(38)) '& strText = Replace(strText, " ", Chr(32)) ' (半角スペース) '正規表現オブジェクト準備 Set regEx = CreateObject("VBScript.RegExp") With regEx .Pattern = "&#x(.+?);" '抽出パターン .Global = True '全件マッチ:True / 先頭マッチ:False End With Set matches = regEx.Execute(strText) '正規表現パターンにマッチした数だけ繰り返し置換 For Each match In matches strHex = CLng("&H" & match.SubMatches(0)) '16進数→10進数へ変換 strUni = ChrW(strHex) '10進数→マルチバイト文字へ変換 strText = Replace(strText, match.Value, strUni) '正規表現にマッチした箇所をマルチバイト文字列で置換 Next htmlDecode = strText End Function
