时间戳

首页 > 解决方案 > Excel中的Base64编码数据列

excel - Excel中的Base64编码数据列

问题描述

在 excel 中，我有一个包含 100 行数据的 A 列，我想为 A 列中的所有项目在 B 列中放置相应的 base 64 编码值。

所以 B1 是 A1 等的编码值

标签： excelvbatobase64string

解决方案

请测试下一个代码：

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

为了解码之前的编码文本（也用于检查），您可以使用下一个函数：

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

可以对其进行测试，从“B:B”列中选择一个单元格，其中先前的代码已返回编码字符串并运行下一个测试Sub：

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

如果创建引用看起来很复杂，请在运行上述代码之前，运行下一个自动创建它：

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

请在运行后保存工作簿，以保留添加的参考。

推荐阅读