How to convert String Picture back to Object, Decoding again

[Dossfm0q]

Here Encoder how to convert to Decoder

Sub EncdPic()


Call EncodeFilebase64("C:\Users\User\Desktop\Untitled.png") '"FullPath with Pic Extention"




End Sub
Public Function EncodeFilebase64(strPicPath As String) As String


    Dim PicExtn As String, FLPath As String
    Dim StrPath As Variant
    Dim BSC As Long
    Dim fso As Object
    
    PicExtn = Split(strPicPath, ".")(1)
   ' StrPath = Split(strPicPath, "\")
    'BSC = UBound(StrPath)
    'FLPath = Left(strPicPath, Len(strPicPath) - Len(StrPath(BSC)))
    
     FLPath = Replace(strPicPath, PicExtn, ".txt")
     
   'or remove ' apostrophe from below
   'FLPath = Replace(strPicPath, PicExtn, ".htm") ' swich to show it in HTML PIC
    
    
    '[SIZE=3][B][COLOR=#ff0000]  [/COLOR][COLOR=#b22222]Please Remove Space after < in "< img[/COLOR][COLOR=#ff0000][/COLOR][/B][/SIZE]
    ' EncodeFilebase64 = "< img src='data:image/" & PicExtn & ";base64," & EncodeFile(strPicPath) & "'/>" ' to be used for HTML
    'or use below
    EncodeFilebase64 = EncodeFile(strPicPath)
    
    'Close notepad File if it open
    
     Close_Notepad_ByName FLPath
     
     ' Kill File
     If Len(Dir(FLPath)) <> 0 Then Kill FLPath
    Set fso = CreateObject("Scripting.FileSystemObject")
 
    Dim Fileout As Object
    Set Fileout = fso.CreateTextFile(FLPath, True, True)
    Fileout.Write EncodeFilebase64
    Fileout.Close
    
    'Open File
    If InStr(1, FLPath, "txt", vbTextCompare) <> 0 Then
    Call Shell("Notepad" & " " & FLPath, vbNormalFocus)
    ElseIf InStr(1, FLPath, "htm", vbTextCompare) <> 0 Then
    
    Call Shell("explorer.exe" & " " & FLPath, vbNormalFocus)
    End If


Set Fileout = Nothing
Set fso = Nothing
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) ' if error check Path is correct or Exist


    ' 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
Public Sub Close_Notepad_ByName(NtpPath As String)


Dim oServ As Object
Dim cProc As Object
Dim oProc As Object
StrProcessName = "Notepad.exe"
Set oServ = GetObject("winmgmts:")
Set cProc = oServ.ExecQuery("select * from win32_process")
For Each oProc In cProc
    If InStr(1, oProc.Name, StrProcessName, vbTextCompare) <> 0 Then ' check if Notepad
        If InStr(1, oProc.CommandLine, NtpPath, vbTextCompare) <> 0 Then ' check Path
        oProc.Terminate
        End If
    End If
Next
Set oServ = Nothing
Set cProc = Nothing
End Sub