'=========================================================
' Requires: Windows API declarations for clipboard control
' Compatible: 32-bit and 64-bit Office
'=========================================================
#If VBA7 Then
Private Declare PtrSafe Function OpenClipboard Lib "user32" (ByVal hwnd As LongPtr) As Long
Private Declare PtrSafe Function CloseClipboard Lib "user32" () As Long
Private Declare PtrSafe Function EmptyClipboard Lib "user32" () As Long
Private Declare PtrSafe Function SetClipboardData Lib "user32" (ByVal wFormat As Long, ByVal hMem As LongPtr) As LongPtr
Private Declare PtrSafe Function GetClipboardData Lib "user32" (ByVal wFormat As Long) As LongPtr
Private Declare PtrSafe Function IsClipboardFormatAvailable Lib "user32" (ByVal wFormat As Long) As Long
Private Declare PtrSafe Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As LongPtr) As LongPtr
Private Declare PtrSafe Function GlobalLock Lib "kernel32" (ByVal hMem As LongPtr) As LongPtr
Private Declare PtrSafe Function GlobalUnlock Lib "kernel32" (ByVal hMem As LongPtr) As Long
Private Declare PtrSafe Function lstrcpy Lib "kernel32" (ByVal lpString1 As LongPtr, ByVal lpString2 As String) As LongPtr
#Else
' For 32-bit Office
' (Use non-PtrSafe declarations with Long instead of LongPtr)
#End If
Private Const CF_TEXT As Long = 1
Private Const GHND As Long = &H42
'---------------------------------------------------------
' Copy text to clipboard
'---------------------------------------------------------
Public Sub CopyToClipboard(ByVal Text As String)
Dim hGlobal As LongPtr, lpGlobal As LongPtr
OpenClipboard 0
EmptyClipboard
hGlobal = GlobalAlloc(GHND, Len(Text) + 1)
lpGlobal = GlobalLock(hGlobal)
lstrcpy lpGlobal, Text
GlobalUnlock hGlobal
SetClipboardData CF_TEXT, hGlobal
CloseClipboard
End Sub
'---------------------------------------------------------
' Read text from clipboard
'---------------------------------------------------------
Public Function GetClipboardText() As String
Dim lpGlobal As LongPtr
Dim Buffer As String
If IsClipboardFormatAvailable(CF_TEXT) = 0 Then Exit Function
OpenClipboard 0
lpGlobal = GetClipboardData(CF_TEXT)
If lpGlobal Then
Buffer = Space(1024) ' Arbitrary buffer size
lstrcpy StrPtr(Buffer), lpGlobal
GetClipboardText = Left(Buffer, InStr(Buffer, vbNullChar) - 1)
End If
CloseClipboard
End Function
Sub TestCopy()
Call CopyToClipboard("Hello from VBA!")
End Sub
Sub TestPaste()
MsgBox GetClipboardText()
End Sub