Text To Clipboard in VBA Windows 10 Issue

Question

I have a function that I use to send a string to the windows clipboard:

Sub TextToClipboard(ByVal Text As String)

  With CreateObject(\"new:{1C3B4210-F441-1         


        

Answer 1

Thanks to the comments under my question I figured out the error was declaring my variables as Long instead of LongPtr. It's still not 100% clear if my first method "TextToClipboard" is failing because of my office instance being 64-bit, but the second method seems to overcome that fine. If anyone else is interested here is the code I modified to read and write to the clipboard that shouldn't be affected by 64 or 32-bit versions of office. My modifications also included getting all of the text even if it's longer than 4096 characters.

For context I'm putting this in a module called 'mClipboard' so that when I call these methods I use 'mClipboard.GetText'.

Hope this helps someone else too!

Option Explicit

#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 LongPtr, ByVal dwBytes As LongPtr) As LongPtr
Private Declare PtrSafe Function CloseClipboard Lib "User32" () As LongPtr
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 lstrcpy Lib "kernel32" (ByVal lpString1 As Any, ByVal lpString2 As Any) As LongPtr
Private Declare PtrSafe Function SetClipboardData Lib "User32" (ByVal wFormat As LongPtr, ByVal hMem As LongPtr) As LongPtr
Private Declare PtrSafe Function GetClipboardData Lib "User32" (ByVal wFormat As LongPtr) As LongPtr
Private Declare PtrSafe Function GlobalSize Lib "kernel32" (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 CloseClipboard Lib "User32" () As Long
Private Declare Function OpenClipboard Lib "User32" (ByVal hwnd As Long) As Long
Private Declare Function EmptyClipboard 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
Private Declare Function GetClipboardData Lib "User32" (ByVal wFormat As Long) As Long
Private Declare Function GlobalSize Lib "kernel32" (ByVal hMem As Long) As Long

#End If



Public Sub SetText(Text As String)


#If VBA7 Then

Dim hGlobalMemory As LongPtr
Dim lpGlobalMemory As LongPtr
Dim hClipMemory As LongPtr

#Else

Dim hGlobalMemory As Long
Dim lpGlobalMemory As Long
Dim hClipMemory As Long

#End If



Const GHND = &H42
Const CF_TEXT = 1

   ' Allocate moveable global memory.
   '-------------------------------------------
   hGlobalMemory = GlobalAlloc(GHND, Len(Text) + 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, Text)

   ' Unlock the memory.
   If GlobalUnlock(hGlobalMemory) <> 0 Then
      MsgBox "Could not unlock memory location. Copy aborted."
      GoTo CloseClipboard
   End If

   ' Open the Clipboard to copy data to.
   If OpenClipboard(0&) = 0 Then
      MsgBox "Could not open the Clipboard. Copy aborted."
      Exit Sub
   End If

   ' Clear the Clipboard.
   Call EmptyClipboard

   ' Copy the data to the Clipboard.
   hClipMemory = SetClipboardData(CF_TEXT, hGlobalMemory)

CloseClipboard:

   If CloseClipboard() = 0 Then
      MsgBox "Could not close Clipboard."
   End If

End Sub

Public Property Get GetText()


#If VBA7 Then

Dim hClipMemory As LongPtr
Dim lpClipMemory As LongPtr

#Else

Dim hClipMemory As Long
Dim lpClipMemory As Long

#End If



Dim MaximumSize As Long
Dim ClipText As String

Const CF_TEXT = 1

   If OpenClipboard(0&) = 0 Then
      MsgBox "Cannot open Clipboard. Another app. may have it open"
      Exit Property
   End If

   ' Obtain the handle to the global memory block that is referencing the text.
   hClipMemory = GetClipboardData(CF_TEXT)
   If IsNull(hClipMemory) Then
      MsgBox "Could not allocate memory"
      GoTo CloseClipboard
   End If

   ' Lock Clipboard memory so we can reference the actual data string.
   lpClipMemory = GlobalLock(hClipMemory)

   If Not IsNull(lpClipMemory) Then
      MaximumSize = 64

      Do
        MaximumSize = MaximumSize * 2

        ClipText = Space$(MaximumSize)
        Call lstrcpy(ClipText, lpClipMemory)
        Call GlobalUnlock(hClipMemory)

      Loop Until ClipText Like "*" & vbNullChar & "*"

      ' Peel off the null terminating character.
      ClipText = Left$(ClipText, InStrRev(ClipText, vbNullChar) - 1)

   Else
      MsgBox "Could not lock memory to copy string from."
   End If

CloseClipboard:

   Call CloseClipboard
   GetText = ClipText

End Property