'******************************************
'base64 module pour fonction range to html
'auteur :patricktoulon sur developez.com
'version:1.2
'date version 12/07/2015
'*******************************************
Sub test()
MsgBox FichierToBase64("C:\Users\Public\Pictures\Sample Pictures\Koala.jpg")
End Sub
Public Function FichierToBase64(chemin As String) As String
Dim XmlDoc As Object, XmlNode As Object, Streamer As Object
Set Streamer = CreateObject("ADODB.Stream")
Set XmlDoc = CreateObject("MSXml2.DOMDocument")
With Streamer
.Type = 1
.Open
.LoadFromFile (chemin)
Set XmlNode = XmlDoc.createElement("Base64Data")
XmlNode.DataType = "bin.base64"
XmlNode.nodeTypedValue = Streamer.Read()
End With
FichierToBase64 = XmlNode.Text
Set XmlDoc = Nothing: Set XmlNode = Nothing: Set Streamer = Nothing
End Function
Sub test2()
Dim chemin$, cod64$
chemin = Environ("userprofile") & "\DeskTop\monimage.png"
Base64ToFichier Feuil1.[A1].Text, chemin 'le code base64 est dans la cellule A1
End Sub
Function Base64ToFichier(ByVal strData As String, ByVal chemin As String) ' As Object
Dim XmlDoc As Object, objNode As Object, a() As Byte, Buffer() As Byte, i&
Set XmlDoc = CreateObject("MSXML2.DOMDocument")
With XmlDoc.createElement("b64")
.DataType = "bin.base64"
.Text = strData
a = .nodeTypedValue
Set XmlDoc = Nothing
'///////////////////////////////////
i& = FreeFile: Open chemin For Binary As #i: Put #i, , a: Close #intFileNumber
End With
End Function