VBA Taking Screen Print and saving to file

So I've been pondering Screen Prints and how they work, in doing so I wondered how some VBA code would take a screen print and save to file. I found lots of fragments of code and then settled on an ideal candidate answer at StackOverflow.

But there is a bug in that code, when calling OleCreatePictureIndirect for the third parameter specify 1 (I define a constant) and not True which is -1. Otherwise, one suffers from "Out of Memory" error either immediately or eventually. Windows API True (1) is not the same as VBA's True (-1).

In addition to the bug fix there is some extra code to thrash the logic Test_ClearTestFiles() and TestMyPrintScreen()

Option Explicit

'* see - Stack Overflow - Is there a way to take a screenshot in MS-Access with vba_
'* https://stackoverflow.com/questions/2456998/is-there-a-way-to-take-a-screenshot-in-ms-access-with-vba/2457169#2457169

Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal _
  bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)

Private Const VK_SNAPSHOT = &H2C
Private Const VK_MENU = &H12
Private Const KEYEVENTF_KEYUP = &H2
Private Const WINAPI_TRUE As Long = 1

Private Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long

Private Declare Function GetClipboardData Lib "user32" (ByVal wFormat As Integer) As Long

Private Declare Function EmptyClipboard Lib "User32.dll" () As Long

Private Declare Function CloseClipboard Lib "user32" () As Long

'https://msdn.microsoft.com/en-us/library/windows/desktop/ms694511(v=vs.85).aspx
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
    Reserved As Long '* added by S Meaden
End Type

Private Const CF_BITMAP = 2
Private Const PICTYPE_BITMAP = 1

Private Sub PrintScreen()
    keybd_event VK_SNAPSHOT, 1, 0, 0
    
    '* the old way
    'keybd_event VK_MENU, 0, 0, 0
    'keybd_event VK_SNAPSHOT, 0, 0, 0
    'keybd_event VK_SNAPSHOT, 0, KEYEVENTF_KEYUP, 0
    'keybd_event VK_MENU, 0, KEYEVENTF_KEYUP, 0
    
End Sub

Private Sub ClearClipboard()
    Dim lRet As Long

    lRet = OpenClipboard(0&)
    If lRet <> 0 Then lRet = EmptyClipboard
    CloseClipboard
End Sub

Private Function CreateIDispatchIID() As GUID
    ' IDispatch interface ID is defined as a GUID with
    ' the value of {00020400-0000-0000-C000-000000000046}.
    Dim IID_IDispatch As GUID
    With IID_IDispatch
        .Data1 = &H20400
        .Data4(0) = &HC0
        .Data4(7) = &H46
    End With
    CreateIDispatchIID = IID_IDispatch

End Function


Private Sub Test_ClearTestFiles()
    Dim fso As Object
    Set fso = VBA.CreateObject("Scripting.FileSystemObject")

    Dim lLoop As Long
    For lLoop = 0 To 50

        Dim sFileName As String
        sFileName = "N:\Test" & lLoop & ".bmp"

        If fso.FileExists(sFileName) Then
            fso.DeleteFile sFileName
        End If
    Next lLoop

End Sub

Private Sub TestMyPrintScreen()

    Static suffix As Long
    suffix = suffix + 1

    'ClearClipboard
    MyPrintScreen "N:\test" & CStr(suffix) & ".bmp"
End Sub


Public Sub MyPrintScreen(FilePathName As String)

    Call PrintScreen

    Dim IID_IDispatch As GUID
    Dim uPicinfo As uPicDesc
    Dim IPic As IPicture
    Dim hPtr As Long

    OpenClipboard 0
    hPtr = GetClipboardData(CF_BITMAP)
    CloseClipboard

    '* Request IDispatch but it will be QueryInterfaced to IPicture by VBA runtime
    IID_IDispatch = CreateIDispatchIID

    '\\ Fill uPicInfo with necessary parts.
    With uPicinfo
        .Size = Len(uPicinfo) '\\ Length of structure.
        .Type = PICTYPE_BITMAP '\\ Type of Picture
        .hPic = hPtr '\\ Handle to image.
        .hPal = 0 '\\ Handle to palette (if bitmap).
    End With


   '\\ Create the Range Picture Object
   '* Bugfix: need WINAPI_TRUE (1) as not VBA True which is -1
   OleCreatePictureIndirect uPicinfo, IID_IDispatch, WINAPI_TRUE, IPic

    '\\ Save Picture Object
    stdole.SavePicture IPic, FilePathName

End Sub