Encoding to Base64
Base64 is an encoding scheme that represents data using 64 characters. It is commonly used in email, software, and web APIs.
In this example, we will show you how to convert text data to Base64 using VBA without any reference settings.
Source Code
'*-------------------------------------------------------------
'* Encode text to Base64
'*
'* @param text The value to be converted
'* @return Base64 formatted data
'*-------------------------------------------------------------
Public Function EncodeToBase64(ByRef text As String) As String
' Prepare the object
Dim node As Object
Set node = CreateObject("Msxml2.DOMDocument.3.0").createElement("base64")
' Encode
node.DataType = "bin.base64"
node.nodeTypedValue = ConvertToBinary(text)
' Remove line breaks that cannot be removed by the function and return
EncodeToBase64 = Replace(node.text, vbLf, "")
End Function
'*-------------------------------------------------------------
'* Convert string to binary data
'*
'* @param text The value to be converted
'* @return Binary data
'*-------------------------------------------------------------
Public Function ConvertToBinary(ByRef text As String)
' Prepare the object
Dim BinaryStream As Object
Set BinaryStream = CreateObject("ADODB.Stream")
' Configure the Stream
With BinaryStream
.Type = 2
.Charset = "us-ascii"
.Open
.WriteText text
.Position = 0
.Type = 1
.Position = 0
End With
ConvertToBinary = BinaryStream.Read
End Function
Test Execution
Execution
Public Sub execute()
Debug.Print (EncodeToBase64("aaa"))
Debug.Print (EncodeToBase64("aab"))
Debug.Print (EncodeToBase64("aac"))
End Sub
Result
YWFh
YWFi
YWFj
Additional Information about Base64
Base64 is an encoding scheme that allows handling multibyte characters and binary data in communication environments where only 64 printable alphanumeric characters can be used and other characters cannot be handled. It is defined by MIME and widely used in email, which can only handle 7-bit data. Specifically, it uses 62 characters from A-Z, a-z, 0-9, two symbols (+, /), and the symbol ”=” is used for padding (to fill the remaining part).
As mentioned above, Base64 is still widely used today, and there are also other encoding schemes such as Base16 and Base32.
Since it is defined by MIME, it is used in VBA when the MIME type of the API specifies Base64, for example.