ADODB.streamオブジェクトを使って文字列とByte配列を相互変換(Excel VBA)

ADODB.streamオブジェクトを使って文字列をByte配列に変換するコードのサンプルです。
ExcelVBAでADODB.streamを使う際には、

1. ExcelのMicrosoft Visual Basic エディタのメニューバーから「ツール->参照設定」とたどる。
2. 表示されたダイアログからMicrosoft ActiveX Data Objectsにチェックを入れる。

という手順が必要です。

文字列からByte配列へ

Private Function ADOS_EncodeStringToByte(ByVal cset As String, ByRef strUni As String) As Byte()
    On Error GoTo e

    Dim objStm As ADODB.stream: Set objStm = New ADODB.stream
    objStm.Mode = adModeReadWrite
    objStm.Open
    objStm.Type = adTypeText
    objStm.Charset = cset
    objStm.WriteText strUni

    objStm.Position = 0
    objStm.Type = adTypeBinary
    Select Case UCase(cset)
      Case "UNICODE", "UTF-16"
        objStm.Position = 2
      Case "UTF-8"
        objStm.Position = 3
    End Select
    ADOS_EncodeStringToByte = objStm.Read()

    objStm.Close
    Set objStm = Nothing

    Exit Function
e:
    Debug.Print "Error occurred while encoding characters" & Err.Description
    If objStm Is Nothing = False Then objStm.Close
    Set objStm = Nothing
End Function

Byte配列から文字列へ

Private Function ADOS_EncodeByteToString(ByVal cset As String, ByRef strUni() As Byte) As String
    On Error GoTo e

    Dim objStm As ADODB.stream: Set objStm = New ADODB.stream
    objStm.Mode = adModeReadWrite
    objStm.Open
    objStm.Type = adTypeBinary
    objStm.Write strUni
    objStm.Flush

    objStm.Position = 0
    objStm.Type = adTypeText
    objStm.Charset = cset
    ADOS_EncodeByteToString = objStm.ReadText
    objStm.Close
    Set objStm = Nothing

    Exit Function
e:
    Debug.Print "Error occured while encoding characters" & Err.Description
    If objStm Is Nothing = False Then objStm.Close
    Set objStm = Nothing
End Function

この記事は
ADODB.Streamでファイル読み込み＠Excel マクロ・VBA
いろんな文字コードでファイルを読み書きするにはADODB.Stream
ADO Stream Object
ADODB.Streamによる文字コード変換のサンプル(VB6)
VB6: How To Convert UTF-8 Byte Arrays into Unicode Strings (and vice versa)
を参照させて頂きました。

ちなみに
WinHttpを使ったPOSTでとりあげたコードを組み合わせれば、「UTF8エンコーディングでStringをHttp POSTするExcel VBAプログラム」ができます。以下のようになります

Private Function httpPostServletUTF8(url As String, data As String) As String
    On Error GoTo e
    
    Dim request() As Byte: request = ADOS_EncodeStringToByte("utf-8", data)
    Dim response() As Byte: response = httpPostServletByte(url, request)
    
    httpPostServletUTF8 = ADOS_EncodeByteToString("utf-8", response)
    Exit Function
e:
    Debug.Print "HttpPostServletUTF8 Error:" & Err.Description
End Function