勉強を兼ねて作ってみました。
いろいろなページをみましたが、下記が分かりやすかったです。
http://www.kumei.ne.jp/c_lang/sdk3/sdk_235.htm
http://www.kumei.ne.jp/c_lang/sdk3/sdk_237.htm
Public Function Base64Encode(b() As Byte) As String
Dim bytBase64() As Byte '変換テーブル
Dim bytSTR() As Byte 'エンコード後の文字列を格納する変数
Dim lngSize As Long '元のサイズを入れておく変数
Dim i As Integer, j As Integer
If Not IsArray(b) Then Exit Function
bytBase64 = StrConv("ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/", vbFromUnicode)
lngSize = UBound(b)
ReDim bytSTR((UBound(b) + 1) * 4 + 1)
If (lngSize + 1 + 3) Mod 3 = 1 Then
ReDim Preserve b(lngSize + 2) '2バイト増やす
End If
If (lngSize + 1 + 3) Mod 3 = 2 Then
ReDim Preserve b(lngSize + 1) '1バイト増やす
End If
j = 0
For i = 0 To UBound(b) Step 3
bytSTR(j) = bytBase64(Int(b(i) / (2 ^ 2))) '右に2ビットシフト
bytSTR(j + 1) = bytBase64(Int((b(i) And &H3) * (2 ^ 4)) + Int(b(i + 1) / (2 ^ 4))) '上位6ビットを0にしてこれを4ビット左シフトして、次の要素を右に4ビットシフトして足す
bytSTR(j + 2) = bytBase64(Int((b(i + 1) And &HF) * (2 ^ 2)) + Int(b(i + 2) / (2 ^ 6))) '上位4ビットを0にしてこれを2ビット左シフトして、次の要素を右に6ビットシフトして足す
bytSTR(j + 3) = bytBase64(Int(b(i + 2) And &H3F)) '上位2ビットを0にする
j = j + 4 'エンコードは4バイトずつ進む
Next
If (lngSize + 1) Mod 3 = 1 Then
bytSTR(j - 2) = AscB("=")
bytSTR(j - 1) = AscB("=")
End If
If (lngSize + 1) Mod 3 = 2 Then
bytSTR(j - 1) = AscB("=")
End If
ReDim Preserve bytSTR(j - 1)
Base64Encode = StrConv(bytSTR, vbUnicode)
End Function