Convert image jpg png jpeg to base64

Question

I am working with the VBA language to import images from a folder and convert these images to BASE64 format.

I imported the images folder in an excel "E1" row. This worked. Here is my result:

Option Explicit

Sub Insert()

Dim strFolder As String
Dim strFileName As String
Dim objPic As Picture
Dim rngCell As Range

strFolder = "C:\Users\Lenovo\Pictures\RonHivkd" 'change the path accordingly
If Right(strFolder, 1) <> "\" Then
    strFolder = strFolder & "\"
End If

Set rngCell = Range("E1") 'starting cell

strFileName = Dir(strFolder & "*.jpg", vbNormal) 'filter for .png files

Do While Len(strFileName) > 0
    Set objPic = ActiveSheet.Pictures.Insert(strFolder & strFileName)
    With objPic
        .Left = rngCell.Left
        .Top = rngCell.Top
        .Height = rngCell.RowHeight
        .Placement = xlMoveAndSize
    End With
    Set rngCell = rngCell.Offset(1, 0)
    strFileName = Dir
Loop

End Sub

Now I would like to convert my images to BASE64. I came across this answer:

Convert image (jpg) to base64 in Excel VBA.

But when I apply the function to a cell that contains the image, I get the result: "#VALUE!" , I do not understand why!

Public Function EncodeFile(strPicPath As String) As String
Const adTypeBinary = 1          ' Binary file is encoded

' Variables for encoding
Dim objXML
Dim objDocElem

' Variable for reading binary picture
Dim objStream

' Open data stream from picture
Set objStream = CreateObject("ADODB.Stream")
objStream.Type = adTypeBinary
objStream.Open
objStream.LoadFromFile (strPicPath)

' Create XML Document object and root node
' that will contain the data
Set objXML = CreateObject("MSXml2.DOMDocument")
Set objDocElem = objXML.createElement("Base64Data")
objDocElem.DataType = "bin.base64"

' Set binary value
objDocElem.nodeTypedValue = objStream.Read()

' Get base64 value
EncodeFile = objDocElem.Text

' Clean all
Set objXML = Nothing
Set objDocElem = Nothing
Set objStream = Nothing

End Function

Answer 1

Try this - it will perform the Base64 conversion at the same time it's importing the images.

Sub InsertAndEncode()

    Dim strFolder As String, strFileName As String, B64 As String
    Dim objPic As Picture, rngCell As Range, ws As Worksheet

    strFolder = "C:\Users\Lenovo\Pictures\RonHivkd"
    If Right(strFolder, 1) <> "\" Then strFolder = strFolder & "\"

    Set ws = ActiveSheet
    Set rngCell = ws.Range("E1") 'starting cell

    strFileName = Dir(strFolder & "*.jpg", vbNormal) 'filter for .png files

    Do While Len(strFileName) > 0

        rngCell.Value = strFileName

        Set objPic = ws.Pictures.Insert(strFolder & strFileName)
        With objPic
            .Left = rngCell.Offset(0, 1).Left
            .Top = rngCell.Offset(0, 1).Top
            .Height = rngCell.RowHeight
            .Placement = xlMove 'not size or adding the B64 will cause problems...
        End With

        'use your existing function to get the Base64 version
        B64 = EncodeFile(strFolder & strFileName)
        If Len(B64) < 32000 Then
            rngCell.Offset(0, 2).Value = B64
        Else
            rngCell.Offset(0, 2).Value = "Too large" 'won't fit in a cell
        End If

        Set rngCell = rngCell.Offset(1, 0)
        strFileName = Dir
    Loop

End Sub
Public Function EncodeFile(strPicPath As String) As String
    Const adTypeBinary = 1          ' Binary file is encoded
    Dim objXML, objDocElem, objStream

    ' Open data stream from picture
    Set objStream = CreateObject("ADODB.Stream")
    objStream.Type = adTypeBinary
    objStream.Open
    objStream.LoadFromFile (strPicPath)
    Set objXML = CreateObject("MSXml2.DOMDocument")
    Set objDocElem = objXML.createElement("Base64Data")
    objDocElem.DataType = "bin.base64"
    objDocElem.nodeTypedValue = objStream.Read()
    EncodeFile = objDocElem.Text

    ' Clean all
    Set objXML = Nothing
    Set objDocElem = Nothing
    Set objStream = Nothing

End Function