VBA API For clipboard functions
''https://docs.microsoft.com/en-us/office/vba/access/Concepts/Windows-API/send-information-to-the-clipboard << Broken code... fixed here and below
Attribute VB_Name = "MyClipboardAPI"
''https://docs.microsoft.com/en-us/office/vba/access/Concepts/Windows-API/send-information-to-the-clipboard
Option Explicit
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
Public Sub PushToClipboardAPI(sUniText As String)
Dim iStrPtr As LongPtr
Dim iLock As LongPtr
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 Or GMEM_ZEROINIT, iLen)
iLock = GlobalLock(iStrPtr)
Dim spv As LongLong
spv = StrPtr(sUniText)
lstrcpy iLock, spv
GlobalUnlock iStrPtr
SetClipboardData CF_UNICODETEXT, iStrPtr
CloseClipboard
End Sub
Public Function GetClipboardAPI() As String
Dim iStrPtr As LongPtr
Dim iLock As LongPtr
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
End Function
Comments
Post a Comment