自動化厨のプログラミングメモブログ│CODE-LIFE

Python/ExcelVBA/JavaScript/Raspberry Piなどで色んなことを自動化

【VBA/VBScript】HTML特殊文字コードから16進数を抽出→10進数に変換してデコードする

CSV形式でダウンロードしたデータの一部が文字化けしていて困ってるという相談を受けて、「読み込み時のエンコード指定の問題でしょw」と見てみると部分的にHTMLエンコードされている謎のCSV・・・。

これに対応すべく部分的なHTMLエンコード文字をデコードして置換するスクリプトを作ってみました。

いろいろ調べてもHTMLエンコードかと思いきやURLエンコードの記事だったりして目標にたどり着くのにちょっと時間がかかってしまいましたが以下を発見。

[VBA] htmlデコード関数 | n218.info

シンプルで分かりやすく、これだ!と思ったけどそのままでは使えなかったの修正して使わせていただきました。

 

この記事で紹介している内容

  • テストのような数値文字参照のHTMLエンコードされた文字列をデコード
  • 文字列の中から変換対象を探し出してデコード後の文字列に置換する関数
  • ドラッグアンドドロップでCSVファイル内のHTMLエンコード文字列をデコードして置換するVBS

 

Excel用ユーザー定義関数

f:id:maru0014:20190611115502p:plain
テスト → テスト のように変換する関数

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, "&lt;", Chr(60))   '<
    strText = Replace(strText, "&gt;", Chr(62))   '>
    strText = Replace(strText, "&amp;", Chr(38))  '&
    strText = Replace(strText, "&nbsp;", 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, "&quot;", Chr(34)) '"
    strText = Replace(strText, "&lt;", Chr(60))   '<
    strText = Replace(strText, "&gt;", Chr(62))   '>
    strText = Replace(strText, "&amp;", Chr(38))  '&
    strText = Replace(strText, "&nbsp;", 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