Only just noticed that my previous method of getting/setting the clipboard has broken in windows 10 so I've written a quick class for clipboard management.
Class Code (I called my class "ClipBoard"):
Code
- Option Explicit
- 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 CountClipboardFormats 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
- Public Sub SetClipboard(clipText As String)
- Const GMEM_MOVEABLE As Long = &H2
- Const GMEM_ZEROINIT As Long = &H40
- Const CF_UNICODETEXT As Long = &HD
- Dim iStrPtr As Long
- Dim iLen As Long
- Dim iLock As Long
- OpenClipboard 0&
- EmptyClipboard
- iLen = LenB(clipText) + 2&
- iStrPtr = GlobalAlloc(GMEM_MOVEABLE Or GMEM_ZEROINIT, iLen)
- iLock = GlobalLock(iStrPtr)
- lstrcpy iLock, StrPtr(clipText)
- GlobalUnlock iStrPtr
- SetClipboardData CF_UNICODETEXT, iStrPtr
- CloseClipboard
- End Sub
- Public Function GetClipboard() As String
- Const CF_UNICODETEXT As Long = 13&
- Dim iStrPtr As Long
- Dim iLen As Long
- Dim iLock As Long
- Dim clipText As String
- OpenClipboard 0&
- If CountClipboardFormats > 0 Then
- If IsClipboardFormatAvailable(CF_UNICODETEXT) Then
- iStrPtr = GetClipboardData(CF_UNICODETEXT)
- If iStrPtr Then
- iLock = GlobalLock(iStrPtr)
- iLen = GlobalSize(iStrPtr)
- clipText = String$(iLen \ 2& - 1&, vbNullChar)
- lstrcpy StrPtr(clipText), iLock
- GlobalUnlock iStrPtr
- End If
- GetClipboard = clipText
- Else
- Debug.Print "Clipboard contents is not a string"
- End If
- Else
- Debug.Print "Clipboard empty"
- End If
- CloseClipboard
- End Function
- Public Sub ClearClipboard()
- OpenClipboard 0&
- EmptyClipboard
- CloseClipboard
- End Sub
- Public Function IsEmpty() As Boolean
- OpenClipboard 0&
- IsEmpty = (CountClipboardFormats = 0)
- CloseClipboard
- End Function
- Private Sub Class_Terminate()
- CloseClipboard
- End Sub
Example usage in a vba module:
Code
Also attached the class as a text file which preserves whitespace (you'll have to rename from ClipBoard.txt to ClipBoard.cls) and can be imported into VBA
hth
Reference: https://docs.microsoft.com/en-…ormation-to-the-clipboard
