VBAでShift-JISのURLエンコード

質問

Excelにおいて、マクロを使ってShint-JIS形式のエンコードを行いたいのですが
その方法(ソース)がネット上で見つかりません。。どなたかご教授いただけないでしょか！

　※VBA(マクロ)について、ぜんぜん詳しくありません。。

検索　⇒　%8c%9f%8d%f5

UTF-8の場合ならば、シンプルなものが見つかりました。
-----------------------------------------------------
Public Function UrlEncode(ByVal sText As String) As String
If Len(sText) = 0 Then Exit Function

With CreateObject("ScriptControl")
.Language = "JScript"
UrlEncode = .CodeObject.encodeURIComponent(sText)
End With

End Function

また、デコードするものも見つかりました。
-----------------------------------------------------
Function URLDecodeSJIS(src)
src = UnEscape(src)
For i = 1 To Len(src)
srcCh1 = AscW(Mid(src, i, 1))
If (&H0 <= srcCh1 And srcCh1 <= &H80) Or (&HA0 <= srcCh1 And srcCh1 <= &HDF) Then
URLDecodeSJIS = URLDecodeSJIS & Chr(srcCh1)
ElseIf (&H81 <= srcCh1 And srcCh1 <= &H9F) Or (&HE0 <= srcCh1 And srcCh1 <= &HFF) Then
i = i + 1
srcCh2 = AscW(Mid(src, i, 1))
clcCh = srcCh1 * 256 + srcCh2
If (Asc(Chr(clcCh)) And &HFFFF&) = clcCh Then clcCh = Chr(clcCh)
URLDecodeSJIS = URLDecodeSJIS & clcCh
End If
Next
End Function

Function UnEscape(s)
With CreateObject("MSScriptControl.ScriptControl")
.Language = "VBScript"
.Reset
UnEscape = .Eval("unescape(""" & s & """)")
End With
End Function

よろしくお願い致します。

回答No.1

queuerev2 · ベストアンサー

なかなか回答がつかないようなので、自信はありませんが回答させていただきます。
（回答がつかないよりはいいと思いますので・・・）

文字をシフトJISの文字コードに直すには、単にAsc関数を使えばいいはずです。ただし、文字コードが&H8000 (32768) 以上のものは負になるので補正が必要です。

Function CharToSJISCode(Char As String) As Long
Dim c As Long
c = Asc(Char)
If c < 0 Then c = c + &H10000
CharToSJISCode = c
End Function

１バイト文字のエンコードですが、文字コードが&H7F (127) 以下のものですが、おそらくUTF-8と同じだと思いますので質問者様提示の関数 UrlEncode をそのまま使わせていただきます。
&H80から&HFF （128から255）はおそらくすべてエンコードすればいいと思います。エンコードの方法は文字コードの16進数2桁の左に%をつけます。
（1バイト文字については特に自信がありません）

Function EncodeSJIS1byte(code) As String
If code <= &H7F Then
EncodeSJIS1byte = UrlEncode(Chr(code))
Else
EncodeSJIS1byte = "%" & Hex(code)
End If
End Function

2バイト文字のエンコードですが、二つに分割して1バイトずつエンコードするのはよいとして、Wikipediaのパーセントエンコーディング(http://ja.wikipedia.org/wiki/%E3%83%91%E3%83%BC%E3%82%BB%E3%83%B3%E3%83%88%E3%82%A8%E3%83%B3%E3%82%B3%E3%83%BC%E3%83%87%E3%82%A3%E3%83%B3%E3%82%B0) のところを読むと、すべてエンコーディングしても、1バイト文字と見なして必要なものだけエンコーディングしてもいいようです。ここでは、後者の方法、具体的には今書いたばかりのEncodeSJIS1byteでエンコードするようにしてみます。

Function EncodeSJIS2byte(Code) As String
EncodeSJIS2byte = EncodeSJIS1byte(Code \ &H100) & EncodeSJIS1byte(Code Mod &H100)
End Function

これまで書いた関数を用いてシフトJISエンコードを書きます。

Function UrlEncodeSJIS(SStr As String) As String
Dim DStr As String
Dim i As Long, c As Long
For i = 1 To Len(SStr)
c = CharToSJISCode(Mid(SStr, i, 1))
If c < &H100 Then
DStr = DStr & EncodeSJIS1byte(c)
Else
DStr = DStr & EncodeSJIS2byte(c)
End If
Next
UrlEncodeSJIS = DStr
End Function

以上です。
最初に申し上げたとおり自信がありません。
そのため、ご使用になる際は十分にテストして不具合がないか確認していただきたくお願いします。

お礼

無事に実装することができました。
素晴らしいです。助かりました。
ありがとうございました！