Encode Base64 data from Clipboard Image - vba

Question

I can get the Base64 data from a CommandBarButton.Picture by copying it to the Windows Clipboard and saving it to file.
Unfortunately, this process is too slow. It takes about 45 seconds to process the 4676 unique images. Is there a way to get the Base64 data directly from an image in the Windows Clipboard?
Alternately, is there a way to Multithread the process? I am working on running a PowerShell script that will process the clipboard but would rather do it directly from the VBA.
Option Explicit
'Referrence: Stephen Bullen: http://www.oaltd.co.uk
'Open the clipboard to read
Private Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
'Get a pointer to the bitmap/metafile
Private Declare Function GetClipboardData Lib "user32" (ByVal wFormat As Integer) As Long
'Close the clipboard
Private Declare Function CloseClipboard Lib "user32" () As Long
'Convert the handle into an OLE IPicture interface.
Private Declare Function OleCreatePictureIndirect Lib "olepro32.dll" (PicDesc As uPicDesc, RefIID As GUID, ByVal fPictureOwnsHandle As Long, IPic As IPicture) As Long
'Declare a UDT to store a GUID for the IPicture OLE Interface
Private Type GUID: Data1 As Long: Data2 As Integer: Data3 As Integer: Data4(0 To 7) As Byte: End Type
'Declare a UDT to store the bitmap information
Private Type uPicDesc: Size As Long: Type As Long: hPic As Long: hPal As Long: End Type
Private Declare Function GetObject Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
Private Declare Function GetBitmapBits Lib "gdi32" (ByVal hBitmap As Long, ByVal dwCount As Long, lpBits As Any) As Long
Private Type Bitmap
bmType As Long
bmWidth As Long
bmHeight As Long
bmWidthBytes As Long
bmPlanes As Integer
bmBitsPixel As Integer
bmBits As Long
End Type
Public Sub SavePictureFromClipBoard(ImagePath As String)
Dim IPic As IPicture
OpenClipboard 0&
OleCreatePictureIndirect getuPicInfo, getIID_IDispatch, True, IPic
SavePicture IPic, ImagePath
CloseClipboard
Set IPic = Nothing
End Sub
Private Function getIID_IDispatch() As GUID
Dim IID_IDispatch As GUID
With IID_IDispatch
.Data1 = &H7BF80980
.Data2 = &HBF32
.Data3 = &H101A:
.Data4(0) = &H8B
.Data4(1) = &HBB
.Data4(2) = &H0
.Data4(3) = &HAA
.Data4(4) = &H0
.Data4(5) = &H30
.Data4(6) = &HC
.Data4(7) = &HAB
End With
getIID_IDispatch = IID_IDispatch
End Function
Private Function getuPicInfo() As uPicDesc
Const PICTYPE_BITMAP = 1
Dim uPicInfo As uPicDesc
' Fill uPicInfo with necessary parts.
With uPicInfo
.Size = Len(uPicInfo) ' Length of structure.
.Type = PICTYPE_BITMAP ' Type of Picture
.hPic = GetClipboardData(xlBitmap) ' Handle to image.
.hPal = xlBitmap ' Handle to palette (if bitmap).
End With
getuPicInfo = uPicInfo
End Function
Public Function getADODBStream(ImagePath As String) As Byte()
Const adTypeBinary = 1
With CreateObject("ADODB.Stream")
.Type = adTypeBinary
.Open
.LoadFromFile (ImagePath)
getADODBStream = .Read()
End With
End Function
Public Function getBase64FromImageFile(ImagePath As String) As String
With CreateObject("MSXml2.DOMDocument")
With .createElement("Base64Data")
.DataType = "bin.base64"
.nodeTypedValue = getADODBStream(ImagePath)
getBase64FromImageFile = .Text
End With
End With
End Function
Public Function getBase64FromByteArray(Bytes() As Byte) As String
With CreateObject("MSXml2.DOMDocument")
With .createElement("Base64Data")
.DataType = "bin.base64"
.nodeTypedValue = Bytes
getBase64FromByteArray = .Text
End With
End With
End Function
Public Function getBytes(Picture1 As IPictureDisp) As Byte()
Dim PicBits() As Byte, PicInfo As Bitmap
GetObject Picture1, Len(PicInfo), PicInfo
ReDim PicBits((PicInfo.bmWidth * PicInfo.bmHeight * 3) - 1) As Byte
GetBitmapBits Picture1, UBound(PicBits), PicBits(0)
getBytes = PicBits()
End Function
Addendum
I am able to read the Byte() from the both the CommandBarButton and the ClipBoard Image. The problem I have i that the Bitmap has a Picture Byte(0 to 767) and a Mask Byte(0 to 767) that combine to form a complete Image. Note: the Mask is sort of background Image that determines the pixel intensity of the Picture. The SavePicture function seems to merge the two parts. The ADODB.Stream saved file returns a Byte(0 to 821).
When copied to the ClipBoard, the Byte() arrays both the ClipBoard IPicture and CommandBarButton Picture are identical.
The three Images above are the CommandBarButton Picture, CommandBarButton Mask, and the Clipboard Image saved to file and then loaded into Image controls.
I am perplexed on how the two Byte() are combined and how the colors are derived from them.