如何在vba中编写实现base64编码的函数？

base64编码是将一个8位字节序列拆散为6位的片段，并为每个6位的片段分配一个字符。

6位字节序列转化为对应的10进制值，然后根据下表找到对应的字符。

由于二进制序列流有时不能正好平均分成6位的块，在这种情况下，就在二进制序列末尾填充位数，使二进制序列的长度成为24的倍数（6和8的最小公倍数）。对已填充的二进制串进行编码时，任何完全填充（不包含原始数据中的位）的6位组都由特殊的第65个符号“=”表示。如果6位组是部分填充的，就将填充位设置为0。

比如数据”a:aa”的填充二进制位为“011000 010011 101001 100001 011000 01xxxx xxxxxx xxxxxx”

其中01xxxx是部分填充的，把填充位都设置为0，也就是变成了010000，最后2个6位组是完全填充的，用符号”=”编码，从而得出”a:aa”的base64编码为YTphYQ==。

基于以上的原理分析，可以使用如下的函数对任意的字符串进行base64编码。

Function Byte2Base64(arrByte() As Byte)
    '定义一个存放3个8位字节的数组
    Dim Bits8(1 To 3)       As Byte
    '顶一个一个存放4个6位字节的数组
    Dim Bits6(1 To 4)       As Byte
    'Base64字符表
    Const Base64Char As String = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/="
    Dim arrBase64Char() As Byte
    '把字符表转换为编码表
    arrBase64Char = VBA.StrConv(Base64Char, vbFromUnicode)
'    Dim arrByte() As Byte
'    '要转换的字节序列
'    arrByte = VBA.StrConv("上网", vbFromUnicode)
    Dim bSize As Long
    bSize = UBound(arrByte) + 1
    For n = 1 To bSize Step 3
        'lLen变量为实际转换的6位字节数组的个数
        For i = 1 To 3
            If i + n - 1 <= bSize Then
                Bits8(i) = arrByte(i - 1 + n - 1)
                lLen = 4
            Else
                '如果不够24的倍数，则填充0
                Bits8(i) = 0
                lLen = lLen - 1
            End If
        Next i
        '将任意连续的3个8位字节序列转换为4个6位的字节序列
        Bits6(1) = (Bits8(1) And &HFC) \ 4
        Bits6(2) = (Bits8(1) And &H3) * &H10 + (Bits8(2) And &HF0) \ &H10
        Bits6(3) = (Bits8(2) And &HF) * 4 + (Bits8(3) And &HC0) \ &H40
        Bits6(4) = Bits8(3) And &H3F
        '通过Base64编码表把4个6位的字节序列转换为字符
        For j = 1 To lLen
            sEncoded = sEncoded & Chr(arrBase64Char(Bits6(j)))
        Next
        '根据lLen的值，判断尾部添加几个"="号。
        Select Case lLen
            Case 2
                sEncoded = sEncoded & "=="
            Case 3
                sEncoded = sEncoded & "="
        End Select
        Debug.Print sEncoded
    Next
    Byte2Base64 = sEncoded
End Function

如果是一般的非中文字符，我们可以使用如下的代码进行Base64编码：

Sub QQ1722187970()
    Dim str1 As String
    str1 = "asd"
    Debug.Print Byte2Base64(VBA.StrConv(str1, vbFromUnicode))
End Sub

当涉及中文字符时，用以上的代码进行编码获得的是gb2312的Base64编码，由于网站经常使用的是utf-8，为此还需要通过以下的代码把unicode字符转换为utf-8编码，以免出现乱码。

Public Declare Function WideCharToMultiByte Lib "kernel32" (ByVal CodePage As Long, _
ByVal dwFlags As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long, _
ByVal lpMultiByteStr As Long, ByVal cchMultiByte As Long, ByVal lpDefaultChar As Long, _
ByVal lpUsedDefaultChar As Long) As Long
Public Declare Function MultiByteToWideChar Lib "kernel32.dll" (ByVal CodePage As Long, _
ByVal dwFlags As Long, ByVal lpMultiByteStr As Long, ByVal cchMultiByte As Long, _
ByVal lpWideCharStr As Long, ByVal cchWideChar As Long) As Long
Public Const CP_UTF8 = 65001
Public Const CP_ACP = 0
Sub QQ1722187970()
    'unicode 转 utf-8
    '定义要转换的字符串变量
   Dim str1 As String
   str1 = "我和你"
   '定义一个变量存储接收实际转换后的字符的字节数
   Dim bByte As Long
   '先调用WideCharToMultiByte函数获取缓冲区字节数
   bByte = WideCharToMultiByte(CP_UTF8, 0, StrPtr(str1), Len(str1), 0, 0, 0, 0)
   Debug.Print bByte
   '定义一个字节数组变量存储转换后的字符字节
   Dim arr() As Byte
   ReDim arr(bByte - 1)
   '再次调用WideCharToMultiByte函数填充字节到arr数组中
   WideCharToMultiByte CP_UTF8, 0, StrPtr(str1), Len(str1), VarPtr(arr(0)), bByte, 0, 0
    Debug.Print Byte2Base64(arr)
'   '遍历字节验证16进制值,可以将字符输入文本文件另存为UTF-8，用二进制查看器打开验证对比
'   For k = 0 To UBound(arr)
'       Debug.Print VBA.Hex(arr(k))
'   Next k
End Sub