Use win clipboard in VBA

fnc_CopyToClipRunCmd.bas

Attribute VB_Name = "fnc_CopyToClipRunCmd"
' namespace=\
' filename=fnc_CopyToClipRunCmd.bas
Option Explicit
'' ! This WinAPI solution doesn't work see notes at EOF

Private Declare PtrSafe Function OpenClipboard Lib "user32.dll" (ByVal hWnd As LongPtr) As LongPtr
Private Declare PtrSafe Function EmptyClipboard Lib "user32.dll" () As LongPtr
Private Declare PtrSafe Function CloseClipboard Lib "user32.dll" () As LongPtr
Private Declare PtrSafe Function IsClipboardFormatAvailable Lib "user32.dll" (ByVal wFormat As LongPtr) As LongPtr
Private Declare PtrSafe Function GetClipboardData Lib "user32.dll" (ByVal wFormat As LongPtr) As LongPtr
Private Declare PtrSafe Function SetClipboardData Lib "user32.dll" (ByVal wFormat As LongPtr, ByVal hMem As LongPtr) As LongPtr
Private Declare PtrSafe Function GlobalAlloc Lib "kernel32.dll" (ByVal wFlags As LongPtr, ByVal dwBytes As LongPtr) As LongPtr
Private Declare PtrSafe Function GlobalLock Lib "kernel32.dll" (ByVal hMem As LongPtr) As LongPtr
Private Declare PtrSafe Function GlobalUnlock Lib "kernel32.dll" (ByVal hMem As LongPtr) As LongPtr
Private Declare PtrSafe Function GlobalSize Lib "kernel32" (ByVal hMem As LongPtr) As LongPtr
Private Declare PtrSafe Function lstrcpy Lib "kernel32.dll" Alias "lstrcpyW" (ByVal lpString1 As LongPtr, ByVal lpString2 As LongPtr) As LongPtr

Public Sub SetClipboard(sUniText As String)
    Dim iStrPtr As LongPtr
    Dim iLen As LongPtr
    Dim iLock As LongPtr
    Const GMEM_MOVEABLE As LongPtr = &H2
    Const GMEM_ZEROINIT As LongPtr = &H40
    Const CF_UNICODETEXT As LongPtr = &HD
    OpenClipboard 0&
    EmptyClipboard
    iLen = LenB(sUniText) + 2&
    iStrPtr = GlobalAlloc(GMEM_MOVEABLE Or GMEM_ZEROINIT, iLen)
    iLock = GlobalLock(iStrPtr)
    lstrcpy iLock, StrPtr(sUniText)
    GlobalUnlock iStrPtr
    SetClipboardData CF_UNICODETEXT, iStrPtr
    CloseClipboard
End Sub

Public Function GetClipboard() As String
    Dim iStrPtr As LongPtr
    Dim iLen As LongPtr
    Dim iLock As LongPtr
    Dim sUniText As String
    Const CF_UNICODETEXT As LongPtr = 13&
    OpenClipboard 0&
    If IsClipboardFormatAvailable(CF_UNICODETEXT) Then
        iStrPtr = GetClipboardData(CF_UNICODETEXT)
        If iStrPtr Then
            iLock = GlobalLock(iStrPtr)
            iLen = GlobalSize(iStrPtr)
            sUniText = String$(iLen \ 2& - 1&, vbNullChar)
            lstrcpy StrPtr(sUniText), iLock
            GlobalUnlock iStrPtr
        End If
        GetClipboard = sUniText
    End If
    CloseClipboard
End Function
''===========================================================================================
'' Procedure: ......... fnc_CopyToClipRunCmd.bas/CopyToClipRunCmd
'' Description: ....... Use RunCommand in VBA to control clipboard
'' Version: ........... 1.0.0 - major.minor.patch
'' Created: ........... 2022-01-21
'' Updated: ........... 2022-02-06
'' Module URL: ........ weburl
'' Installs to: ....... https://gist.githubusercontent.com/lundeen-bryan/e50a967f5d0b01ce8491647ab8442c40/raw/f9432b0db07344d9a4b284df41fe124408caa94f/fnc_CopyToClipRunCmd.bas
'' Compatibility: ..... Excel,Word,etc.
'' Contact Author: .... [email protected]
'' Copyright:  ........ none ©2022. All rights reserved.
'' Called by: ......... other_subs
'' Calls to: .......... other_subs
'' Parameters: ........ parameters
'' Return: ............ type param_description
'' Notes: ............. _
'' (1) This solution to copy to/from the clipboard uses the WinAPI and was originally meant to
''     work on Acess VBA, not Excel. However it was written by an Excel guy named Chris Macro.
''     The solution doesn't really work in Excel, may not work on any 64bit PC. So it is
''     ! Now defunct.
'' (2) Modified from MSDN code found at _
''     https://archive.is/sHTga
''     There is a typo in the MSDN code where it says, "lstrcpyW iLock, iStrPtr(sUniText)" which
''     should say "lstrcpyW" and "iStrPtr" - note this was supposedly developed by Chris Newman
''     of TheSpreadsheetGuru website a.k.a. "Chris Macro" he later rejected his own code on his
''     blog at https://archive.is/eGjL4
''     and opted to use a solution proposed by Daniel Ferry from ExcelHero website that
''     uses the HTML Object Library instead of WinAPI.
'' (3) The most recent test of this code throws a "Compile error: Type mismatch" on line 49 02/06-BL
''===========================================================================================

fnc_CopyToClipWinApi.bas

Attribute VB_Name = "fnc_CopyToClipWinApi"
Option Explicit

#If VBA7 Then
  Private Declare PtrSafe Function OpenClipboard Lib "User32" (ByVal hWnd As LongPtr) As LongPtr
  Private Declare PtrSafe Function EmptyClipboard Lib "User32" () As LongPtr
  Private Declare PtrSafe Function CloseClipboard Lib "User32" () As LongPtr
  Private Declare PtrSafe Function IsClipboardFormatAvailable Lib "User32" (ByVal wFormat As LongPtr) As LongPtr
  Private Declare PtrSafe Function GetClipboardData Lib "User32" (ByVal wFormat As LongPtr) As LongPtr
  Private Declare PtrSafe Function SetClipboardData Lib "User32" (ByVal wFormat As LongPtr, ByVal hMem As LongPtr) As LongPtr
  Private Declare PtrSafe Function GlobalAlloc Lib "kernel32.dll" (ByVal wFlags As Long, ByVal dwBytes As Long) As LongPtr
  Private Declare PtrSafe Function GlobalLock Lib "kernel32.dll" (ByVal hMem As LongPtr) As LongPtr
  Private Declare PtrSafe Function GlobalUnlock Lib "kernel32.dll" (ByVal hMem As LongPtr) As LongPtr
  Private Declare PtrSafe Function GlobalSize Lib "kernel32" (ByVal hMem As LongPtr) As Long
  Private Declare PtrSafe Function lstrcpy Lib "kernel32.dll" Alias "lstrcpyW" (ByVal lpString1 As Any, ByVal lpString2 As Any) As LongPtr
#Else
  Private Declare Function OpenClipboard Lib "user32.dll" (ByVal hWnd As Long) As Long
  Private Declare Function EmptyClipboard Lib "user32.dll" () As Long
  Private Declare Function CloseClipboard Lib "user32.dll" () As Long
  Private Declare Function IsClipboardFormatAvailable Lib "user32.dll" (ByVal wFormat As Long) As Long
  Private Declare Function GetClipboardData Lib "user32.dll" (ByVal wFormat As Long) As Long
  Private Declare Function SetClipboardData Lib "user32.dll" (ByVal wFormat As Long, ByVal hMem As Long) As Long
  Private Declare Function GlobalAlloc Lib "kernel32.dll" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
  Private Declare Function GlobalLock Lib "kernel32.dll" (ByVal hMem As Long) As Long
  Private Declare Function GlobalUnlock Lib "kernel32.dll" (ByVal hMem As Long) As Long
  Private Declare Function GlobalSize Lib "kernel32" (ByVal hMem As Long) As Long
  Private Declare Function lstrcpy Lib "kernel32.dll" Alias "lstrcpyW" (ByVal lpString1 As Long, ByVal lpString2 As Long) As Long
#End If

Public Sub SetClipboard(sUniText As String)

    #If VBA7 Then
    Dim iStrPtr As LongPtr
    Dim iLock As LongPtr
    #Else
    Dim iStrPtr As Long
    Dim iLock As Long
    #End If

    Dim iLen As Long

    Const GMEM_MOVEABLE As Long = &H2
    Const GMEM_ZEROINIT As Long = &H40
    Const CF_UNICODETEXT As Long = &HD

    OpenClipboard 0&
    EmptyClipboard
    iLen = LenB(sUniText) + 2&
    iStrPtr = GlobalAlloc(GMEM_MOVEABLE + GMEM_ZEROINIT, iLen)
    iLock = GlobalLock(iStrPtr)
    lstrcpy iLock, StrPtr(sUniText)
    GlobalUnlock iStrPtr
    SetClipboardData CF_UNICODETEXT, iStrPtr
    CloseClipboard
End Sub

Public Function GetClipboard() As String
    #If VBA7 Then
    Dim iStrPtr As LongPtr
    Dim iLock As LongPtr
    #Else
    Dim iStrPtr As Long
    Dim iLock As Long
    #End If
    Dim iLen As Long
    Dim sUniText As String

    Const CF_UNICODETEXT As Long = 13&

    OpenClipboard 0&

    If IsClipboardFormatAvailable(CF_UNICODETEXT) Then
        iStrPtr = GetClipboardData(CF_UNICODETEXT)
        If iStrPtr Then
            iLock = GlobalLock(iStrPtr)
            iLen = GlobalSize(iStrPtr)
            sUniText = String$(iLen \ 2& - 1&, vbNullChar)
            lstrcpy StrPtr(sUniText), iLock
            GlobalUnlock iStrPtr
        End If
        GetClipboard = sUniText
    End If

    CloseClipboard

''===========================================================================================
'' Procedure: ......... fnc_CopyToClipWinApi.bas/GetClipboard_fnc
'' Description: ....... This will get the string on the clipboard using WinAPI
'' Version: ........... 1.0.0 - major.minor.patch
'' Created: ........... 2022-02-05
'' Updated: ........... 2022-02-05
'' Module URL: ........ https://gist.github.com/lundeen-bryan/f927033a8ecba8a3ad1933b20211dea0
'' Installs to: ....... Outlook_Macros/Modules
'' Compatibility: ..... Excel,Word,etc.
'' Contact Author: .... [email protected]
'' Copyright:  ........ none © 2022. All rights reserved.
'' Called by: ......... other_subs
'' Calls to: .......... other_subs
'' Parameters: ........ parameters
'' Return: ............ type param_description
'' Notes: ............. _
 (1) notes_here
''===========================================================================================
End Function

Sub ClipboardTest()
    Call SetClipboard(Selection)
    Debug.Print GetClipboard
End Sub