VBA Clipboard: Copy/Retrieve string & Empty

There’s some kind of trouble in Windows 8 and Windows 10 that prevents from copying text to the clipboard using the “Microsoft Forms 2.0 Object Library” DataObject, which is a very simplistic solution that can be programmed with late binding so no need to set previous reference to the library. So to achieve the clipboard management we can rely in API calls, a more complex structure. The code posted next can save the deal.

Option Explicit

#If Mac Then
    ' do nothing
#Else
    #If VBA7 Then
        Private Declare PtrSafe Function GlobalUnlock Lib "kernel32" (ByVal hMem As LongPtr) As LongPtr
        Private Declare PtrSafe Function GlobalLock Lib "kernel32" (ByVal hMem As LongPtr) As LongPtr
        Private Declare PtrSafe Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As LongPtr) As LongPtr
        Private Declare PtrSafe Function OpenClipboard Lib "User32" (ByVal hwnd As LongPtr) As LongPtr
        Private Declare PtrSafe Function CountClipboardFormats Lib "User32" () As Long
        Private Declare PtrSafe Function EmptyClipboard Lib "User32" () As Long
        Private Declare PtrSafe Function CloseClipboard Lib "User32" () As Long
        Private Declare PtrSafe Function lstrcpy Lib "kernel32" (ByVal lpString1 As Any, ByVal lpString2 As Any) As LongPtr
        Private Declare PtrSafe Function SetClipboardData Lib "User32" (ByVal wFormat As Long, ByVal hMem As LongPtr) As LongPtr
    #Else
        Private Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
        Private Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
        Private Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
        Private Declare Function OpenClipboard Lib "User32" (ByVal hwnd As Long) As Long
        Private Declare Function CountClipboardFormats Lib "User32" () As Long
        Private Declare Function EmptyClipboard Lib "User32" () As Long
        Private Declare Function CloseClipboard Lib "User32" () As Long
        Private Declare Function lstrcpy Lib "kernel32" (ByVal lpString1 As Any, ByVal lpString2 As Any) As Long
        Private Declare Function SetClipboardData Lib "User32" (ByVal wFormat As Long, ByVal hMem As Long) As Long
    #End If
#End If

Private Const GHND = &H42
Private Const CF_TEXT = 1
Private Const MAXSIZE = 4096

Public Function CopyToClipboard(ByVal myString As String)
    ' If Windows version  8, 10 then
    'Dim MSForms_DataObject As Object
    'Set MSForms_DataObject = CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
    'MSForms_DataObject.SetText Text
    'MSForms_DataObject.PutInClipboard
    'Set MSForms_DataObject = Nothing
    
    Dim lgRetVal As Long

    #If Mac Then
        With New MSForms.DataObject
            .SetText myString
            .PutInClipboard
        End With
    #Else
        #If VBA7 Then
            Dim hGlobalMemory As LongPtr
            Dim hClipMemory As LongPtr
            Dim lpGlobalMemory As LongPtr
        #Else
            Dim hGlobalMemory As Long
            Dim hClipMemory As Long
            Dim lpGlobalMemory As Long
        #End If
        
        ' Allocate moveable global memory.
        hGlobalMemory = GlobalAlloc(GHND, Len(myString) + 1)
    
        ' Lock the block to get a far pointer to this memory.
        lpGlobalMemory = GlobalLock(hGlobalMemory)
    
        ' Copy the string to this global memory.
        lpGlobalMemory = lstrcpy(lpGlobalMemory, myString)
    
        ' Unlock the memory.
        If GlobalUnlock(hGlobalMemory)  0 Then
            lgRetVal = MsgBox("Could not unlock memory location. Copy aborted.", vbOKOnly + vbExclamation, "W A R N I N G")
            Exit Function
        End If
    
       ' Open the Clipboard to copy data to.
        If OpenClipboard(0&) = 0 Then
            lgRetVal = MsgBox("Could not open the Clipboard. Copy aborted.", vbOKOnly + vbExclamation, "W A R N I N G")
            Exit Function
        End If
    
        ' Clear the Clipboard.
        lgRetVal = EmptyClipboard()
    
        ' Copy the data to the Clipboard.
        hClipMemory = SetClipboardData(CF_TEXT, hGlobalMemory)
    
ExitProc:
        If CloseClipboard() = 0 Then
            lgRetVal = MsgBox("Could not close Clipboard.", vbOKOnly + vbExclamation, "W A R N I N G")
        End If
    #End If

End Function

Public Function GetClipboardText(Optional ByRef nChars As Integer = 0) As String
    Dim MSForms_DataObject As Object
    
    Set MSForms_DataObject = CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
    MSForms_DataObject.GetFromClipboard
    If nChars = 0 Then nChars = Len(MSForms_DataObject.GetText)
    GetClipboardText = Left(MSForms_DataObject.GetText, nChars) ' Get only first nChars
    Set MSForms_DataObject = Nothing
End Function

Public Sub ClearClipboard()
    Dim lgRetVal As Long

    If Not (CountClipboardFormats() = 0) Then 'Clipboard is not empty
        lgRetVal = OpenClipboard(0&)
        If lgRetVal  0 Then lgRetVal = EmptyClipboard
        CloseClipboard
    End If
End Sub