'VBA Base64 解码/解密函数：

Function Base64Decode(B64 As String) As String 'Base64 解码

On Error GoTo over '排错

Dim OutStr() As Byte, i As Long, j As Long

Const B64_CHAR_DICT = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/="

If InStr(1, B64, "=") <> 0 Then B64 = Left(B64, InStr(1, B64, "=") - 1) '判断Base64真实长度,除去补位

Dim kk, length As Long, mods As Long

mods = Len(B64) Mod 4

length = Len(B64) - mods

ReDim OutStr(length / 4 * 3 - 1 + Switch(mods = 0, 0, mods = 2, 1, mods = 3, 2))

For i = 1 To length Step 4

Dim buf(3) As Byte

For j = 0 To 3

buf(j) = InStr(1, B64_CHAR_DICT, Mid(B64, i + j, 1)) - 1 '根据字符的位置取得索引值

Next

OutStr((i - 1) / 4 * 3) = buf(0) * &H4 + (buf(1) And &H30) / &H10

OutStr((i - 1) / 4 * 3 + 1) = (buf(1) And &HF) * &H10 + (buf(2) And &H3C) / &H4

OutStr((i - 1) / 4 * 3 + 2) = (buf(2) And &H3) * &H40 + buf(3)

Next

If mods = 2 Then

OutStr(length / 4 * 3) = (InStr(1, B64_CHAR_DICT, Mid(B64, length + 1, 1)) - 1) * &H4 + ((InStr(1, B64_CHAR_DICT, Mid(B64, length + 2, 1)) - 1) And &H30) / 16

ElseIf mods = 3 Then

OutStr(length / 4 * 3) = (InStr(1, B64_CHAR_DICT, Mid(B64, length + 1, 1)) - 1) * &H4 + ((InStr(1, B64_CHAR_DICT, Mid(B64, length + 2, 1)) - 1) And &H30) / 16

OutStr(length / 4 * 3 + 1) = ((InStr(1, B64_CHAR_DICT, Mid(B64, length + 2, 1)) - 1) And &HF) * &H10 + ((InStr(1, B64_CHAR_DICT, Mid(B64, length + 3, 1)) - 1) And &H3C) / &H4

End If

For i = 0 To UBound(OutStr)

Base64Decode = Base64Decode & Chr(OutStr(i))

Next i '读取解码结果

over:

End Function

'VBA Base64 解码/解密函数：

Function Base64Decode(B64 As String) As String 'Base64 解码

On Error GoTo over '排错

Dim OutStr() As Byte, i As Long, j As Long

Const B64_CHAR_DICT = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/="

If InStr(1, B64, "=") <> 0 Then B64 = Left(B64, InStr(1, B64, "=") - 1) '判断Base64真实长度,除去补位

Dim kk, length As Long, mods As Long

mods = Len(B64) Mod 4

length = Len(B64) - mods

ReDim OutStr(length / 4 * 3 - 1 + Switch(mods = 0, 0, mods = 2, 1, mods = 3, 2))

For i = 1 To length Step 4

Dim buf(3) As Byte

For j = 0 To 3

buf(j) = InStr(1, B64_CHAR_DICT, Mid(B64, i + j, 1)) - 1 '根据字符的位置取得索引值

Next

OutStr((i - 1) / 4 * 3) = buf(0) * &H4 + (buf(1) And &H30) / &H10

OutStr((i - 1) / 4 * 3 + 1) = (buf(1) And &HF) * &H10 + (buf(2) And &H3C) / &H4

OutStr((i - 1) / 4 * 3 + 2) = (buf(2) And &H3) * &H40 + buf(3)

Next

If mods = 2 Then

OutStr(length / 4 * 3) = (InStr(1, B64_CHAR_DICT, Mid(B64, length + 1, 1)) - 1) * &H4 + ((InStr(1, B64_CHAR_DICT, Mid(B64, length + 2, 1)) - 1) And &H30) / 16

ElseIf mods = 3 Then

OutStr(length / 4 * 3) = (InStr(1, B64_CHAR_DICT, Mid(B64, length + 1, 1)) - 1) * &H4 + ((InStr(1, B64_CHAR_DICT, Mid(B64, length + 2, 1)) - 1) And &H30) / 16

OutStr(length / 4 * 3 + 1) = ((InStr(1, B64_CHAR_DICT, Mid(B64, length + 2, 1)) - 1) And &HF) * &H10 + ((InStr(1, B64_CHAR_DICT, Mid(B64, length + 3, 1)) - 1) And &H3C) / &H4

End If

For i = 0 To UBound(OutStr)

Base64Decode = Base64Decode & Chr(OutStr(i))

Next i '读取解码结果

over:

End Function