How do I base64 encode a string efficiently using Excel VBA

Question

I need to encode a 100KB  string as base64 in VBA  Are there any built-in functions or COM objects available which will do this as a pure VBA approach is either complex or doesn t scale well at these volumes  see links from dbb and marxidad

User · Accepted Answer

You can use the MSXML Base64 encoding functionality as described at www nonhostile com howto-encode-decode-base64-vb6 asp   Function EncodeBase64 text As String  As String   Dim arrData   As Byte   arrData   StrConv text  vbFromUnicode           Dim objXML As MSXML2 DOMDocument   Dim objNode As MSXML2 IXMLDOMElement    Set objXML   New MSXML2 DOMDocument    Set objNode   objXML createElement  b64      objNode dataType    bin base64    objNode nodeTypedValue   arrData   EncodeBase64   objNode Text     Set objNode   Nothing   Set objXML   Nothing End Function

User · Answer

As Mark C points out  you can use the MSXML Base64 encoding functionality as described here  I prefer late binding because it s easier to deploy  so here s the same function that will work without any VBA references  Function EncodeBase64 text As String  As String   Dim arrData   As Byte   arrData   StrConv text  vbFromUnicode     Dim objXML As Variant   Dim objNode As Variant    Set objXML   CreateObject  quot MSXML2 DOMDocument quot     Set objNode   objXML createElement  quot b64 quot      objNode dataType    quot bin base64 quot    objNode nodeTypedValue   arrData   EncodeBase64   objNode text    Set objNode   Nothing   Set objXML   Nothing End Function

User · Answer

This code works very fast  It comes from here  Option Explicit  Private Const clOneMask   16515072           000000 111111 111111 111111 Private Const clTwoMask   258048             111111 000000 111111 111111 Private Const clThreeMask   4032             111111 111111 000000 111111 Private Const clFourMask   63                111111 111111 111111 000000  Private Const clHighMask   16711680          11111111 00000000 00000000 Private Const clMidMask   65280              00000000 11111111 00000000 Private Const clLowMask   255                00000000 00000000 11111111  Private Const cl2Exp18   262144              2 to the 18th power Private Const cl2Exp12   4096                2 to the 12th Private Const cl2Exp6   64                   2 to the 6th Private Const cl2Exp8   256                  2 to the 8th Private Const cl2Exp16   65536               2 to the 16th  Public Function Encode64 sString As String  As String      Dim bTrans 63  As Byte  lPowers8 255  As Long  lPowers16 255  As Long  bOut   As Byte  bIn   As Byte     Dim lChar As Long  lTrip As Long  iPad As Integer  lLen As Long  lTemp As Long  lPos As Long  lOutSize As Long      For lTemp   0 To 63                                  Fill the translation table          Select Case lTemp             Case 0 To 25                 bTrans lTemp    65   lTemp               A - Z             Case 26 To 51                 bTrans lTemp    71   lTemp               a - z             Case 52 To 61                 bTrans lTemp    lTemp - 4                1 - 0             Case 62                 bTrans lTemp    43                       Chr 43                    Case 63                 bTrans lTemp    47                       Chr 47                End Select     Next lTemp      For lTemp   0 To 255                                 Fill the 2 8 and 2 16 lookup tables          lPowers8 lTemp    lTemp   cl2Exp8         lPowers16 lTemp    lTemp   cl2Exp16     Next lTemp      iPad   Len sString  Mod 3                            See if the length is divisible by 3     If iPad Then                                         If not  figure out the end pad and resize the input          iPad   3 - iPad         sString   sString  amp  String iPad  Chr 0       End If      bIn   StrConv sString  vbFromUnicode                 Load the input string      lLen     UBound bIn    1    3    4                   Length of resulting string      lTemp   lLen   72                                    Added space for vbCrLfs      lOutSize     lTemp   2    lLen  - 1                  Calculate the size of the output buffer      ReDim bOut lOutSize                                  Make the output buffer       lLen   0                                             Reusing this one  so reset it       For lChar   LBound bIn  To UBound bIn  Step 3         lTrip   lPowers16 bIn lChar     lPowers8 bIn lChar   1     bIn lChar   2      Combine the 3 bytes         lTemp   lTrip And clOneMask                      Mask for the first 6 bits         bOut lPos    bTrans lTemp   cl2Exp18             Shift it down to the low 6 bits and get the value         lTemp   lTrip And clTwoMask                      Mask for the second set          bOut lPos   1    bTrans lTemp   cl2Exp12         Shift it down and translate          lTemp   lTrip And clThreeMask                    Mask for the third set          bOut lPos   2    bTrans lTemp   cl2Exp6          Shift it down and translate          bOut lPos   3    bTrans lTrip And clFourMask     Mask for the low set          If lLen   68 Then                                Ready for a newline             bOut lPos   4    13                          Chr 13    vbCr             bOut lPos   5    10                          Chr 10    vbLf             lLen   0                                     Reset the counter             lPos   lPos   6         Else             lLen   lLen   4             lPos   lPos   4         End If     Next lChar      If bOut lOutSize    10 Then lOutSize   lOutSize - 2  Shift the padding chars down if it ends with CrLf       If iPad   1 Then                                     Add the padding chars if any          bOut lOutSize    61                              Chr 61            ElseIf iPad   2 Then         bOut lOutSize    61         bOut lOutSize - 1    61     End If      Encode64   StrConv bOut  vbUnicode                   Convert back to a string and return it   End Function  Public Function Decode64 sString As String  As String      Dim bOut   As Byte  bIn   As Byte  bTrans 255  As Byte  lPowers6 63  As Long  lPowers12 63  As Long     Dim lPowers18 63  As Long  lQuad As Long  iPad As Integer  lChar As Long  lPos As Long  sOut As String     Dim lTemp As Long      sString   Replace sString  vbCr  vbNullString        Get rid of the vbCrLfs   These could be in        sString   Replace sString  vbLf  vbNullString        either order       lTemp   Len sString  Mod 4                           Test for valid input      If lTemp Then         Call Err Raise vbObjectError   MyDecode    Input string is not valid Base64        End If      If InStrRev sString        Then                      InStrRev is faster when you know it s at the end          iPad   2                                         Note   These translate to 0  so you can leave them        ElseIf InStrRev sString       Then                   in the string and just resize the output          iPad   1     End If      For lTemp   0 To 255                                 Fill the translation table          Select Case lTemp             Case 65 To 90                 bTrans lTemp    lTemp - 65               A - Z             Case 97 To 122                 bTrans lTemp    lTemp - 71               a - z             Case 48 To 57                 bTrans lTemp    lTemp   4                1 - 0             Case 43                 bTrans lTemp    62                       Chr 43                    Case 47                 bTrans lTemp    63                       Chr 47                End Select     Next lTemp      For lTemp   0 To 63                                  Fill the 2 6  2 12  and 2 18 lookup tables          lPowers6 lTemp    lTemp   cl2Exp6         lPowers12 lTemp    lTemp   cl2Exp12         lPowers18 lTemp    lTemp   cl2Exp18     Next lTemp      bIn   StrConv sString  vbFromUnicode                 Load the input byte array      ReDim bOut    UBound bIn    1    4    3  - 1         Prepare the output buffer       For lChar   0 To UBound bIn  Step 4         lQuad   lPowers18 bTrans bIn lChar      lPowers12 bTrans bIn lChar   1                        lPowers6 bTrans bIn lChar   2      bTrans bIn lChar   3              Rebuild the bits          lTemp   lQuad And clHighMask                     Mask for the first byte         bOut lPos    lTemp   cl2Exp16                    Shift it down         lTemp   lQuad And clMidMask                      Mask for the second byte         bOut lPos   1    lTemp   cl2Exp8                 Shift it down         bOut lPos   2    lQuad And clLowMask             Mask for the third byte         lPos   lPos   3     Next lChar      sOut   StrConv bOut  vbUnicode                       Convert back to a string      If iPad Then sOut   Left  sOut  Len sOut  - iPad     Chop off any extra bytes      Decode64   sOut  End Function

[vba] How do I base64 encode a string efficiently using Excel VBA?

Examples related to vba

Examples related to excel

Examples related to encoding

Examples related to base64