Option Explicit
Private Const c_iHEIGHTDIMENSION As Integer = 180
Private Const c_iWIDTHDIMENSION As Integer = 364
Private Const c_sFILEEXTENSION As String = "PNG"
Private sPath As String
Private sFile As String
Private vDimensions() As Variant
Private vFileProperties As Variant
Sub CreateBase64StringFromLastScreenshot()
sPath = Environ("LOCALAPPDATA") & "\Packages\MicrosoftWindows.Client.CBS_cw5n1h2txyewy\TempState\ScreenClip\"
vFileProperties = GetLastFileFromClipboard()
sFile = vFileProperties(0)
If Not sFile = vbNullString Then
With CreateObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
.SetText "<p> <img src=""data:image/jpeg;base64," & encodeBase64(readBytes(sFile)) & """ Height=""" & vFileProperties(1) & "px"" width=""" & vFileProperties(2) & "px""/></p>"
.PutInClipboard
End With
End If
End Sub
Function readBytes(ByVal sFile As String) As Byte()
With CreateObject("ADODB.Stream")
.Open
.Type = 1
.LoadFromFile sFile
readBytes = .Read()
End With
End Function
Function encodeBase64(bytes)
With CreateObject("Microsoft.XMLDOM")
With .createElement("tmp")
.DataType = "bin.base64"
.nodeTypedValue = bytes
encodeBase64 = Replace(Replace(.Text, vbCr, ""), vbLf, "")
End With
End With
End Function
Function GetLastFileFromClipboard() As Variant
Dim rs As Object
Dim fso As Object
Dim fil As Object
Set rs = CreateObject("ADODB.Recordset")
rs.Fields.Append "Filename", 129, 255
rs.Fields.Append "DateCreated", 5
rs.Fields.Append "Height", 3
rs.Fields.Append "Width", 3
rs.Open
Set fso = CreateObject("Scripting.FileSystemObject")
With fso
With .GetFolder(sPath)
For Each fil In .Files
If UCase$(fso.GetExtensionName(fil)) = c_sFILEEXTENSION Then
vDimensions() = GetImageDimensions(fil.Path)
If Not vDimensions(0) = c_iHEIGHTDIMENSION And Not vDimensions(1) = c_iWIDTHDIMENSION Then
rs.addnew Array(0, 1, 2, 3), Array(fil.Path, fil.DateCreated, vDimensions(0), vDimensions(1)): rs.Update
End If
End If
Next
End With
End With
If Not rs.RecordCount = 0 Then
rs.movefirst
rs.Sort = rs.Fields(1).Name & " DESC," & rs.Fields(2).Name & " DESC"
GetLastFileFromClipboard = Array(RTrim(rs.Fields(0).Value), rs.Fields(2).Value, rs.Fields(3).Value)
rs.Close
Else
GetLastFileFromClipboard = vbNullString
End If
End Function
Function GetImageDimensions(ByVal sImageFile As String) As Variant
Static oWIA As ImageFile
If oWIA Is Nothing Then: Set oWIA = CreateObject("WIA.ImageFile")
With oWIA
.LoadFile sImageFile
GetImageDimensions = Array(oWIA.Height, oWIA.Width)
End With
End Function