Base64 desde Excel | Codificar y decodificar

Hola a todos mis seguidores del mundo, hoy veremos un tema muy poco difundido y es la Base64 desde Excel

Base64: Método de codificación aplicado a datos binarios para mostrar información en una cadena de caracteres en código ASCII

Fuente: https://solucionfactible.com/sfic/capitulos/timbrado/base64.jsp

Es muy utilizado en plataformas web, pero no sólo lo podemos aplicar desde ahí

Ejemplo de generación Base64

Por ejemplo la frase «Tutoriales Excel» en base64 se representaría como «VHV0b3JpYWxlcyBFeGNlbA==»

Podemos generarlo de manera online en diferentes plataformas como la siguiente base64encode.org

Utilizar hash desde Excel

Código para generar Base64 desde Excel VBA

El código que vamos a utilizar es el siguiente

Option Explicit

Private InitDone       As Boolean
Private Map1(0 To 63)  As Byte
Private Map2(0 To 127) As Byte

Public Function Base64EncodeString(ByVal s As String) As String
   Base64EncodeString = Base64Encode(ConvertStringToBytes(s))
End Function

Private Function Base64Encode(InData() As Byte)
   Base64Encode = Base64Encode2(InData, UBound(InData) - LBound(InData) + 1)
End Function

Private Function Base64Encode2(InData() As Byte, ByVal InLen As Long) As String
   If Not InitDone Then Init
   If InLen = 0 Then Base64Encode2 = "": Exit Function
   Dim ODataLen As Long: ODataLen = (InLen * 4 + 2) \ 3
   Dim OLen As Long: OLen = ((InLen + 2) \ 3) * 4
   Dim Out() As Byte
   ReDim Out(0 To OLen - 1) As Byte
   Dim ip0 As Long: ip0 = LBound(InData)
   Dim ip As Long
   Dim op As Long
   Do While ip < InLen
      Dim i0 As Byte: i0 = InData(ip0 + ip): ip = ip + 1
      Dim i1 As Byte: If ip < InLen Then i1 = InData(ip0 + ip): ip = ip + 1 Else i1 = 0
      Dim i2 As Byte: If ip < InLen Then i2 = InData(ip0 + ip): ip = ip + 1 Else i2 = 0
      Dim o0 As Byte: o0 = i0 \ 4
      Dim o1 As Byte: o1 = ((i0 And 3) * &H10) Or (i1 \ &H10)
      Dim o2 As Byte: o2 = ((i1 And &HF) * 4) Or (i2 \ &H40)
      Dim o3 As Byte: o3 = i2 And &H3F
      Out(op) = Map1(o0): op = op + 1
      Out(op) = Map1(o1): op = op + 1
      Out(op) = IIf(op < ODataLen, Map1(o2), Asc("=")): op = op + 1
      Out(op) = IIf(op < ODataLen, Map1(o3), Asc("=")): op = op + 1
      Loop
   Base64Encode2 = ConvertBytesToString(Out)
End Function

Public Function Base64DecodeString(ByVal s As String) As String
   If s = "" Then Base64DecodeString = "": Exit Function
   Base64DecodeString = ConvertBytesToString(Base64Decode(s))
End Function

Private Function Base64Decode(ByVal s As String) As Byte()
   If Not InitDone Then Init
   Dim IBuf() As Byte: IBuf = ConvertStringToBytes(s)
   Dim ILen As Long: ILen = UBound(IBuf) + 1
   If ILen Mod 4 <> 0 Then Err.Raise vbObjectError, , "Length of Base64 encoded input string is not a multiple of 4."
   Do While ILen > 0
      If IBuf(ILen - 1) <> Asc("=") Then Exit Do
      ILen = ILen - 1
      Loop
   Dim OLen As Long: OLen = (ILen * 3) \ 4
   Dim Out() As Byte
   ReDim Out(0 To OLen - 1) As Byte
   Dim ip As Long
   Dim op As Long
   Do While ip < ILen
      Dim i0 As Byte: i0 = IBuf(ip): ip = ip + 1
      Dim i1 As Byte: i1 = IBuf(ip): ip = ip + 1
      Dim i2 As Byte: If ip < ILen Then i2 = IBuf(ip): ip = ip + 1 Else i2 = Asc("A")
      Dim i3 As Byte: If ip < ILen Then i3 = IBuf(ip): ip = ip + 1 Else i3 = Asc("A")
      If i0 > 127 Or i1 > 127 Or i2 > 127 Or i3 > 127 Then _
         Err.Raise vbObjectError, , "Illegal character in Base64 encoded data."
      Dim b0 As Byte: b0 = Map2(i0)
      Dim b1 As Byte: b1 = Map2(i1)
      Dim b2 As Byte: b2 = Map2(i2)
      Dim b3 As Byte: b3 = Map2(i3)
      If b0 > 63 Or b1 > 63 Or b2 > 63 Or b3 > 63 Then _
         Err.Raise vbObjectError, , "Illegal character in Base64 encoded data."
      Dim o0 As Byte: o0 = (b0 * 4) Or (b1 \ &H10)
      Dim o1 As Byte: o1 = ((b1 And &HF) * &H10) Or (b2 \ 4)
      Dim o2 As Byte: o2 = ((b2 And 3) * &H40) Or b3
      Out(op) = o0: op = op + 1
      If op < OLen Then Out(op) = o1: op = op + 1
      If op < OLen Then Out(op) = o2: op = op + 1
      Loop
   Base64Decode = Out
End Function

Public Function Base64ToImage(RutaArchivo As String) As String
    Const adTypeBinary = 1
    Dim objXML, objDocElem, objStream

    Set objStream = CreateObject("ADODB.Stream")
    objStream.Type = adTypeBinary
    objStream.Open
    objStream.LoadFromFile (RutaArchivo)

    Set objXML = CreateObject("MSXml2.DOMDocument")
    Set objDocElem = objXML.createElement("Base64Data")
    objDocElem.DataType = "bin.base64"

    objDocElem.nodeTypedValue = objStream.Read()

    Base64ToImage = objDocElem.Text 'Obtiene el valor de la Base64

    Set objXML = Nothing
    Set objDocElem = Nothing
    Set objStream = Nothing
End Function

Private Sub Init()
   Dim c As Integer, i As Integer

   i = 0
   For c = Asc("A") To Asc("Z"): Map1(i) = c: i = i + 1: Next
   For c = Asc("a") To Asc("z"): Map1(i) = c: i = i + 1: Next
   For c = Asc("0") To Asc("9"): Map1(i) = c: i = i + 1: Next
   Map1(i) = Asc("+"): i = i + 1
   Map1(i) = Asc("/"): i = i + 1

   For i = 0 To 127: Map2(i) = 255: Next
   For i = 0 To 63: Map2(Map1(i)) = i: Next
   InitDone = True
End Sub

Private Function ConvertStringToBytes(ByVal s As String) As Byte()
   Dim b1() As Byte: b1 = s
   Dim l As Long: l = (UBound(b1) + 1) \ 2
   If l = 0 Then ConvertStringToBytes = b1: Exit Function
   Dim b2() As Byte
   ReDim b2(0 To l - 1) As Byte
   Dim p As Long
   For p = 0 To l - 1
      Dim c As Long: c = b1(2 * p) + 256 * CLng(b1(2 * p + 1))
      If c >= 256 Then c = Asc("?")
      b2(p) = c
      Next
   ConvertStringToBytes = b2
End Function

Private Function ConvertBytesToString(b() As Byte) As String
   Dim l As Long: l = UBound(b) - LBound(b) + 1
   Dim b2() As Byte
   ReDim b2(0 To (2 * l) - 1) As Byte
   Dim p0 As Long: p0 = LBound(b)
   Dim p As Long
   For p = 0 To l - 1: b2(2 * p) = b(p0 + p): Next
   Dim s As String: s = b2
   ConvertBytesToString = s
End Function

Lo puedes descargar desde el siguiente enlace Base64.bas

Una vez descargado lo importamos desde nuestro editor en Visual Basic

Importar módulo .bas a excel

Una vez importado lo usaremos de la siguiente forma

Sub prueba()
    MsgBox Base64.Base64EncodeString("Tutoriales Excel")
End Sub

Y obtenemos el siguiente resultado

Y de manera similar, para poder decodificar el texto, lo haremos de la siguiente forma

Sub prueba2()
    MsgBox Base64.Base64DecodeString("VHV0b3JpYWxlcyBFeGNlbA==")
End Sub

Convertir imagen en local a base64

Vale, convertir una imagen que tenemos en local a base64 también lo podemos hacer con el BAS que te he compartido

Sub macroDePrueba()
    Dim respuesta As String
    respuesta = Base64ToImage("D:\2.jpg")
    MsgBox respuesta
End Sub

Y con un msgbox podemos obtener una

base64 image local vba

Leer imagen en Base64 desde Excel

Bien! En muchas ocasiones vamos a tener la necesidad de leer una imagen «codificada» en base64

Por ejemplo en la página base64-image.de tenemos una imagen en base64

Leer imagenes desde excel

Y deseo obtenerla a mi archivo Excel, lo cual podría ser un poco complicado

¿Por qué puede ser complicado obtener una imagen en Base64 desde Excel?

Porque las imágenes no direccionan a una ruta en específico, sino un texto ilegible. Si usamos el inpeccionador de elementos podemos visualizarlo

imagen Base64 desde excel

El src es igual a data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAQoAAAFmCAMAAACiIyTaAAABv1BMVEUAAAB5S0dJSkpISkpLTU3pSzzoTD3oSzzoTD…

Para leer la imagen en Base64 desde excel seguiremos dos sencillos pasos:

Paso #1: Listar las imágenes de la web deseada

Para poder listar todas las imágenes de una página web podemos usar el siguiente código

Sub correr()
    Dim ie As Object, images As Object, image As Object, misimagenes(10) As String, cuerpo$
    Set ie = CreateObject("InternetExplorer.Application")
 
    ie.Visible = 0: ie.navigate "https://www.base64-image.de"
    
    Do
        DoEvents
    Loop Until ie.readyState = 4
    
    Set images = ObtenerTodasLasImagenes(ie)
    i = 0
    For Each image In images
      misimagenes(i) = image.getAttribute("src")
      i = i + 1
    Next image

    ie.Quit
    
End Sub
Function ObtenerTodasLasImagenes(ie As Object) As Object
  Set ObtenerTodasLasImagenes = ie.document.images
End Function

Todas la imágenes las guardamos en el array misimagenes

En mi caso la imagen que deseo se almacena en misimagenes(1)

Paso #2: Leer la imagen en Base64 desde VBA

Primero analicemos la estructura de las imagenes en base64 de una manera rápida

Las imágenes tienen la siguiente forma:data:image/png;base64,iVBORw0KGgoAAAANSUhEUg…

Después de «image/» podemos visualizar la extensión de la imagen, la cual es png (En este caso)

El texto base64 que debemos decodificar para obtener la imagen se encuentra después de «base64,» el cual es iVBORw0KGgoAAAANSUhEUg…

Este texto lo vamos a obtener con funciones de texto VBA, de la siguiente forma

Sub correr()
    Dim ie As Object, images As Object, image As Object, misimagenes(10) As String, cuerpo$
    Set ie = CreateObject("InternetExplorer.Application")

    ie.Visible = 0: ie.navigate "https://www.base64-image.de"
    
    Do
        DoEvents
    Loop Until ie.readyState = 4
    
    Set images = ObtenerTodasLasImagenes(ie)
    i = 0
    For Each image In images
      misimagenes(i) = image.getAttribute("src")
      i = i + 1
    Next image
    
    Open ThisWorkbook.Path & "\miImagen.png" For Binary As #1
        Put #1, 1, DecodeImageBase64(Mid(misimagenes(1), 23, Len(misimagenes(1)) - 3))
    Close #1
    
    ie.Quit
    
End Sub

Siendo la función DecodeImageBase64 la siguiente:

Private Function DecodeImageBase64(ByVal strData As String) As Byte()
 
    Set objXML = CreateObject("MSXML2.DOMDocument")
    Set objNode = CreateObject("MSXML2.DOMDocument.6.0")

    Set objNode = objXML.createElement("b64")
    
    objNode.DataType = "bin.base64"
    objNode.Text = strData
    DecodeImageBase64 = objNode.nodeTypedValue
    
    Set objNode = Nothing
    Set objXML = Nothing
    
End Function

La imagen se guardará en el mismo lugar en donde se encuentra el archivo, después de ejecutar la macro correr()

decode image vba excel

Descargar archivo .BAS con el código trabajado

Como en la mayoría de ejercicios, les comparto el código del desarrollo Base64Imagen.bas (Contraseña tutorialesexcel.com)

Recuerda que puedes descargar todos mis archivos excel desde Repositorio Tutoriales Excel, la contraseña de todos los archivos es tutorialesexcel.com

Cualquier consulta la puedes dejar en los comentarios o enviar un mensaje al correo Luisrojas@tutorialesexcel.com

En unos meses estaré lanzando mi curso online de Excel VBA básico, debido a que veo mucha necesidad de empezar bien en este mundo

Esta entrada tiene 2 comentarios

  1. Mae Kelley

    Gracias por compartir un artículo tan informativo. Realmente un artículo útil. Y gracias por compartir el fragmento también.

  2. Dantte666

    Tus articulos son geniales.

Deja una respuesta