Option Explicit
Const SplitSize As Long = 256
Sub encode()
Dim i As Long, filename As String, temp As String, cnt As Long
[a:a].ClearContents
filename = "c:\a.jpg"
If Dir(filename) = vbNullString Then MsgBox filename: Exit Sub
[a1] = filename
temp = EncodeFile(filename)
ReDim data(1 To Len(temp) \ SplitSize + 1, 1 To 1) As String
Do
cnt = cnt + 1
data(cnt, 1) = Left(temp, SplitSize)
temp = Mid(temp, SplitSize + 1)
Loop Until temp = vbNullString
[a2].Resize(cnt) = data
End Sub
Sub decode()
Dim temp As String, data As Variant, i As Long, filename As String
data = [a1].CurrentRegion.Resize(, 1).Value
If Not IsArray(data) Then MsgBox "!": Exit Sub
For i = 2 To UBound(data)
temp = temp & data(i, 1)
Next
Do
filename = "c:\" & Int(Rnd * 10 ^ 8) & ".jpg"
Loop Until Dir(filename) = vbNullString
Call decodeBase64ToJpg(temp, filename)
Call insertpicture(filename, "c1")
End Sub
Function insertpicture(filename, address)
Dim pictemp As Object
With ActiveSheet
.Range(address).Select
Set pictemp = .Pictures.Insert(filename)
End With
With pictemp
.Name = filename
.Placement = xlMoveAndSize
End With
End Function
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
Function decodeBase64ToJpg(ByVal strData As String, ByVal ImgPath As String)
Dim xml As Object: Set xml = CreateObject("MSXML2.DOMDocument")
Dim stm As Object: Set stm = CreateObject("ADODB.Stream")
With xml
.resolveExternals = False
.LoadXML ("<data>" & strData & "</data>")
.DocumentElement.setAttribute "xmlns:dt", "urn:schemas-microsoft-com:datatypes"
.DocumentElement.DataType = "bin.base64"
End With
With stm
.Type = 1 'adTypeBinary
.Open
.Write xml.DocumentElement.nodeTypedValue
.SaveToFile ImgPath
.Close
End With
Set xml = Nothing
Set stm = Nothing
End Function