Execlセル内でbase64エンコードする

外部に提出しないExeclは効率UPのため2003を使用しています。最新のExeclでは、base64 エンコードくらいあるかと思っていましたが、ないんですね。「Execl base64」で検索してもあまり出てこなかったので、マクロExecl .xlm で作成しました。

Win32 APIの暗号化ライブラリで、API:CryptBinaryToStringA があったのでそちらの .dll を動的参照います。使用します。1コールでいけます。コードは以下の通りです。2003や32bit版offsice ビルドスイッチで切り分けています。URLセーフ(URLで使えない記号を置き替え、%xxのURLエンコードとはだいぶちがう) は、APIないので作りました。VBAエディタで「標準モジュール」に挿入します。

#If Win64 Then
Private Declare PtrSafe Function CryptBinaryToStringA Lib "Crypt32.dll" _
                            (pbBinary As Byte, _
                             ByVal cbBinary As Long, _
                             ByVal dwFlags As Long, _
                             pszString As Byte, _
                             pcchString As Long) As Long
#Else
Private Declare Function CryptBinaryToStringA Lib "Crypt32.dll" _
                            (pbBinary As Byte, _
                             ByVal cbBinary As Long, _
                             ByVal dwFlags As Long, _
                             pszString As Byte, _
                             pcchString As Long) As Long
#End If


Private Const CRYPT_STRING_BASE64HEADER As Long = &H0 ' Base64。証明書の先頭と末尾のヘッダーが含まれます。
Private Const CRYPT_STRING_BASE64 As Long = &H1 ' ヘッダーなしの Base64。
Private Const CRYPT_STRING_BINARY As Long = &H2 ' 純粋なバイナリ コピー。
Private Const CRYPT_STRING_BASE64REQUESTHEADER As Long = &H3 '要求の開始ヘッダーと終了ヘッダーを含む Base64。
Private Const CRYPT_STRING_HEX As Long = &H4 ' 16 進数のみ。
Private Const CRYPT_STRING_HEXASCII As Long = &H5 ' ASCII 文字表示の 16 進数。
Private Const CRYPT_STRING_BASE64X509CRLHEADER As Long = &H9 ' Base64( X.509 CRL の先頭ヘッダーと終了ヘッダーを含む)。
Private Const CRYPT_STRING_HEXADDR As Long = &HA 'アドレス表示を含む 16 進数。
Private Const CRYPT_STRING_HEXASCIIADDR As Long = &HB 'ASCII 文字とアドレス表示を含む 16 進数。
Private Const CRYPT_STRING_HEXRAW As Long = &HC ' 生の 16 進文字列。
Private Const CRYPT_STRING_STRICT = &H20000000 ' ASN.1 テキスト形式の厳密なデコードを適用します。

' BASE64
Public Function BASE64(ByVal hexData As String) As String
    On Error GoTo ERROR01

    BASE64 = "Error"
    
    ' String HEX をByte配列に変換
    Dim binIn(512) As Byte
    Dim binOut(512) As Byte
    Dim result As Long
    Dim sizeIn As Long
    Dim sizeIo As Long
   
    sizeIn = 0
    Dim i As Long

    If Len(hexData) = 0 Then
        Return
    End If
    
     If Len(hexData) Mod 2 <> 0 Then
        Return
    End If
    
    If Len(hexData) / 2 > UBound(binIn) - 1 Then
        Return
    End If
    
    For i = 1 To Len(hexData) Step 2
        binIn(sizeIn) = CLng("&h" & Mid(hexData, i, 2)) '16進バイナリ値に
        sizeIn = sizeIn + 1
    Next i
    
    sizeIo = UBound(binIn) - 1
    
    ' BASE64に変換
    result = CryptBinaryToStringA(binIn(0), sizeIn, CRYPT_STRING_BASE64, binOut(0), sizeIo)
    If result = 0 Then Return

    Dim base64str As String
    base64str = ""
    
    For i = 0 To sizeIo - 1
        base64str = base64str & Chr(binOut(i)) 'ASII値を文字に
    Next i
    
    BASE64 = base64str
    Exit Function
    
ERROR01:
End Function

' URL Safe BASE64
Public Function BASE64URLSAFE(ByVal hexData As String) As String
    On Error GoTo ERROR01

    BASE64URLSAFE = "Error"

    Dim base64str As String
    
    base64str = BASE64(hexData)
    If base64str = "Error" Then Exit Function
    
    ' URLエンコードと違い文字置換のみ
    ' Win32APIは無い。
    base64str = Replace(base64str, "=", "")
    base64str = Replace(base64str, "+", "-")
    base64str = Replace(base64str, "/", "_")
    
    BASE64URLSAFE = base64str
    Exit Function

ERROR01:
End Function

ちゃんとAPIエラー、引数エラー、VBエラー検出も組込みましょう。ネット上のサンプルはそれがあまりできていないようで実用上問題です。Execlの記述は、