0

In excel I have a column A with 100 rows of data, I would like to place the corresponding base 64 encoded value in column B for all items in column A.

So B1 is the encoded value of A1 etc

1 Answers1

1

Please, test the next code:

Sub testEncodeColumn()
   Dim sh As Worksheet, lastR As Long, arr, arrFin, i As Long
   
   Set sh = ActiveSheet
   lastR = sh.Range("A" & sh.rows.count).End(xlUp).row
   arr = sh.Range("A2:A" & lastR).Value 'place the range in an array for faster iteration
   ReDim arrFin(1 To UBound(arr), 1 To 1)
   For i = 1 To UBound(arr)
        arrFin(i, 1) = EncodeBase64(CStr(arr(i, 1)))
   Next i
   'drop the array content at once:
   sh.Range("B2").Resize(UBound(arr), 1).Value = arrFin
End Sub

Function EncodeBase64(txt As String) As String
  'it needs a reference to 'Microsoft XML, V6.0'
  Dim arr() As Byte: arr = StrConv(txt, vbFromUnicode)
  Dim objXML As MSXML2.DOMDocument60

  Set objXML = New MSXML2.DOMDocument60
  With objXML.createElement("b64")
    .DataType = "bin.base64"
    .nodeTypedValue = arr
    EncodeBase64 = .text
  End With
End Function

In order to decode the previous encoded text (for checking, too), you can use the next function:

Private Function DecodeBase64(ByVal strData As String) As Byte()
    Dim objXML As MSXML2.DOMDocument60

    Set objXML = New MSXML2.DOMDocument60
    With objXML.createElement("b64")
        .DataType = "bin.base64"
        .text = strData
        DecodeBase64 = .nodeTypedValue
   End With
End Function

It can be tested, selecting one cell from column "B:B", where an encoded string has been returned by the previous code and run the next testing Sub:

Sub testDecodeBase64()
  Debug.Print StrConv(DecodeBase64(ActiveCell.Value), vbUnicode)
End Sub

If creating the reference looks complicated, please, before running the above code, run the next one to create it automatically:

Sub addXMLRef()
  'Add a reference to 'Microsoft XML, V6.0':
  'In case of error ('Programmatic access to Visual Basic Project not trusted'):
  'Options->Trust Center->Trust Center Settings->Macro Settings->Developer Macro Settings->
  '         check "Trust access to the VBA project object model"
  On Error Resume Next
  Application.VBE.ActiveVBProject.References.AddFromFile "C:\Windows\System32\msxml6.dll"
  If err.Number = 32813 Then
        err.Clear: On Error GoTo 0
        MsgBox "The reference already exists...": Exit Sub
  Else
        On Error GoTo 0
        MsgBox """XML, V6.0"" reference added successfully..."
  End If
End Sub

Please, save the workbook after running it, in order to keep the added reference.

FaneDuru
  • 38,298
  • 4
  • 19
  • 27