Link to home
Start Free TrialLog in
Avatar of peispud
peispudFlag for Canada

asked on

Clipboard SetText and GetText for 32 and 64 bit versions of Microsoft Access

Hi

Using Microsoft Access VBA

  • I would like to write text to a clipboard. 
  • I would like to be able to put text into a clipboard

The code must be able to work on a 32 bit & 64 bit version of Microsoft Access


I have 32 bit code that works but not on a 64 bit version of Microsoft Access.


Any help would be appreciated.



Avatar of Maria Barnes
Maria Barnes
Flag of United States of America image

Most of the 32 bit API functions can be used in 64 bit when prefaced by PtrSafe and changing Long types to LongPtr.  Here is a copy of what I am using.  This was taken at one point from http://access.mvps.org/access/api/api0049.htm and then since "converted" to be usable in either 32 or 64 bit.

'*********  Code Start  ************
' This code was originally written by Terry Kreft.
' It is not to be altered or distributed,
' except as part of an application.
' You are free to use it in any application,
' provided the copyright notice is left unchanged.
'
' Code Courtesy of
' Terry Kreft
'
Public Const GHND = &H42
Public Const CF_TEXT = 1
Private Const CF_ANSIONLY = &H400&
Private Const CF_APPLY = &H200&
Private Const CF_BITMAP = 2
Private Const CF_DIB = 8
Private Const CF_DIF = 5
Private Const CF_DSPBITMAP = &H82
Private Const CF_DSPENHMETAFILE = &H8E
Private Const CF_DSPMETAFILEPICT = &H83
Private Const CF_DSPTEXT = &H81
Private Const CF_EFFECTS = &H100&
Private Const CF_ENABLEHOOK = &H8&
Private Const CF_ENABLETEMPLATE = &H10&
Private Const CF_ENABLETEMPLATEHANDLE = &H20&
Private Const CF_ENHMETAFILE = 14
Private Const CF_FIXEDPITCHONLY = &H4000&
Private Const CF_FORCEFONTEXIST = &H10000
Private Const CF_GDIOBJFIRST = &H300
Private Const CF_GDIOBJLAST = &H3FF
Private Const CF_HDROP = 15
Private Const CF_INITTOLOGFONTSTRUCT = &H40&
Private Const CF_LIMITSIZE = &H2000&
Private Const CF_LOCALE = 16
Private Const CF_MAX = 17
Private Const CF_METAFILEPICT = 3
Private Const CF_NOFACESEL = &H80000
Private Const CF_NOSCRIPTSEL = &H800000
Private Const CF_NOSIMULATIONS = &H1000&
Private Const CF_NOSIZESEL = &H200000
Private Const CF_NOSTYLESEL = &H100000
Private Const CF_NOVECTORFONTS = &H800&
Private Const CF_NOOEMFONTS = CF_NOVECTORFONTS
Private Const CF_NOVERTFONTS = &H1000000
Private Const CF_OEMTEXT = 7
Private Const CF_OWNERDISPLAY = &H80
Private Const CF_PALETTE = 9
Private Const CF_PENDATA = 10
Private Const CF_PRINTERFONTS = &H2
Private Const CF_PRIVATEFIRST = &H200
Private Const CF_PRIVATELAST = &H2FF
Private Const CF_RIFF = 11
Private Const CF_SCALABLEONLY = &H20000
Private Const CF_SCREENFONTS = &H1
Private Const CF_BOTH = (CF_SCREENFONTS Or CF_PRINTERFONTS)
Private Const CF_SCRIPTSONLY = CF_ANSIONLY
Private Const CF_SELECTSCRIPT = &H400000
Private Const CF_SHOWHELP = &H4&
Private Const CF_SYLK = 4
Private Const CF_TIFF = 6
Private Const CF_TTONLY = &H40000
Private Const CF_UNICODETEXT = 13
Private Const CF_USESTYLE = &H80&
Private Const CF_WAVE = 12
Private Const CF_WYSIWYG = &H8000

Private Declare PtrSafe Function GlobalAlloc Lib "kernel32" (ByVal wFlags&, ByVal _
  dwBytes As LongPtr) As LongPtr
Private Declare PtrSafe Function GlobalLock Lib "kernel32" (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" (ByVal lpString1 As Any, _
  ByVal lpString2 As Any) As LongPtr
Private Declare PtrSafe Function lstrlen Lib "kernel32" Alias "lstrlenA" _
  (ByVal lpString As String) As LongPtr

Private Declare PtrSafe Function GlobalUnlock Lib "kernel32" (ByVal hMem As LongPtr) _
  As LongPtr

Private Declare PtrSafe Function OpenClipboard Lib "user32" (ByVal Hwnd As LongPtr) _
  As LongPtr
Private Declare PtrSafe Function CloseClipboard Lib "user32" () As LongPtr
Private Declare PtrSafe Function GetClipboardData Lib "user32" (ByVal wFormat As _
  LongPtr) As LongPtr
Private Declare PtrSafe Function EmptyClipboard Lib "user32" () As LongPtr
Private Declare PtrSafe Function SetClipboardData Lib "user32" (ByVal wFormat _
  As LongPtr, ByVal hMem As LongPtr) As LongPtr

Function ClipBoard_SetText(strCopyString As String) As Boolean
  Dim hGlobalMemory As LongPtr
  Dim lpGlobalMemory As LongPtr
  Dim hClipMemory As LongPtr

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

  ' Unlock the memory and then copy to the clipboard
  If GlobalUnlock(hGlobalMemory) = 0 Then
    If OpenClipboard(0&) <> 0 Then
      Call EmptyClipboard
      hClipMemory = SetClipboardData(CF_TEXT, hGlobalMemory)
      ClipBoard_SetText = CBool(CloseClipboard)
    End If
  End If
End Function

Function ClipBoard_GetText() As String
  Dim hClipMemory As LongPtr
  Dim lpClipMemory As LongPtr
  Dim strCBText As String
  Dim RetVal As LongPtr
  Dim lngSize As LongPtr
  If OpenClipboard(0&) <> 0 Then
    ' Obtain the handle to the global memory
    ' block that is referencing the text.
    hClipMemory = GetClipboardData(CF_TEXT)
    If hClipMemory <> 0 Then
      ' Lock Clipboard memory so we can reference
      ' the actual data string.
      lpClipMemory = GlobalLock(hClipMemory)
      If lpClipMemory <> 0 Then
        lngSize = GlobalSize(lpClipMemory)
        strCBText = Space$(CLng(lngSize))
        RetVal = lstrcpy(strCBText, lpClipMemory)
        RetVal = GlobalUnlock(hClipMemory)
        ' Peel off the null terminating character.
        strCBText = Left(strCBText, InStr(1, strCBText, Chr$(0), 0) - 1)
      Else
        MsgBox "Could not lock memory to copy string from."
      End If
    End If
    Call CloseClipboard
  End If
  ClipBoard_GetText = strCBText
End Function


'*********  Code End   ************


Avatar of Daniel Pineault
Daniel Pineault

Post your code and we'll help you convert it.
@Maria shouldn't

Private Declare PtrSafe Function GlobalAlloc Lib "kernel32" (ByVal wFlags&, ByVal dwBytes As LongPtr) As LongPtr

Open in new window


be

Private Declare PtrSafe Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As LongPtr) As LongPtr

Open in new window

ASKER CERTIFIED SOLUTION
Avatar of Maria Barnes
Maria Barnes
Flag of United States of America image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial