[AccessD] copy string to clipboard

Long way around for a shortcut. But this might not be so safe.

'set reference to FM20.dll in windows/system32 'MS Forms 2.0 Object Library
function getclipboard() as string
Dim dobD As DataObject
 Dim strS As String
  Set dobD = New DataObject
   dobD.GetFromClipboard
  strS = dobD.GetText
'or put in formatted see object browser
 ' dobD.SetText ("Huh??")
 ' dobD.PutInClipboard
  Debug.Print strS
getclipboard= strS
   Set dobD = Nothing
End Sub

John W. Colby wrote:

>>I've even got a simple class to take care of text to and from the clipboard
>>    
>>
><g>
>
>And of course, so do I now, thanks to you.  <grin>  This is what makes this
>group great.
>
>John W. Colby
>www.ColbyConsulting.com 
>
>Contribute your unused CPU cycles to a good cause:
>http://folding.stanford.edu/
>
>-----Original Message-----
>From: accessd-bounces at databaseadvisors.com
>[mailto:accessd-bounces at databaseadvisors.com] On Behalf Of Heenan, Lambert
>Sent: Thursday, August 18, 2005 12:03 PM
>To: 'Access Developers discussion and problem solving'
>Subject: RE: [AccessD] copy string to clipboard
>
>
>
>-----Original Message-----
>From: accessd-bounces at databaseadvisors.com
>[mailto:accessd-bounces at databaseadvisors.com] On Behalf Of John W. Colby
>Sent: Thursday, August 18, 2005 11:00 AM
>To: 'Access Developers discussion and problem solving'
>Subject: RE: [AccessD] copy string to clipboard
>
>
>Where is the matching ClipGetText?
>
>John W. Colby
>www.ColbyConsulting.com 
>
>------------------------
>It's another simple API call...
>
>Private Declare Function GetClipboardData Lib "user32" (ByVal wFormat As
>Long) As Long
>
>I've even got a simple class to take care of text to and from the clipboard
><g>
>
>'*************************** clsClipBoard *************
>
>Option Compare Database
>Option Explicit
>
>
>
>' Obtaining Clipboard Data using API
>' (needed for VBA since no Clipboard Object) -- can also paste the data to a
>control ' *************************************************************
>
>' ******* Place following in declarations *********
>Private Declare Function OpenClipboard Lib "user32" (ByVal hWnd As Long) As
>Long Private Declare Function CloseClipboard Lib "user32" () As Long Private
>Declare Function EmptyClipboard Lib "user32" () 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 GlobalAlloc Lib "kernel32" (ByVal wFlags&, ByVal
>dwBytes As Long) As Long Private Declare Function GlobalLock Lib "kernel32"
>(ByVal hMem As Long) As Long Private Declare Function GlobalUnlock Lib
>"kernel32" (ByVal hMem As Long) As Long Private Declare Function GlobalSize
>Lib "kernel32" (ByVal hMem As Long) As Long Private Declare Function lstrcpy
>Lib "kernel32" (ByVal lpString1 As Any, ByVal lpString2 As Any) As Long
>
>Const GHND = &H42
>Const CF_TEXT = 1
>Const MAXSIZE = 4096
>
>Function GetTextData() As String
>   Dim hClipMemory As Long
>   Dim lpClipMemory As Long
>   Dim MyString As String
>   Dim RetVal As Long
>
>   If OpenClipboard(0&) = 0 Then
>      MsgBox "Cannot open Clipboard. Another app. may have it open", ,
>"Clipboard"
>
>      Exit Function
>   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", , "Clipboard"
>   Else
>   
>      ' Lock Clipboard memory so we can reference
>      ' the actual data string.
>      lpClipMemory = GlobalLock(hClipMemory)
>   
>      If Not IsNull(lpClipMemory) Then
>   
>         MyString = SPACE$(MAXSIZE)
>         RetVal = lstrcpy(MyString, lpClipMemory)
>         RetVal = GlobalUnlock(hClipMemory)
>   
>         ' Peel off the null terminating character.
>         MyString = uMid(MyString, 1, InStr(1, MyString, Chr$(0), 0) - 1)
>      Else
>         MsgBox "Could not lock memory to copy string from.", , "Clipboard"
>      End If
>   
>   End If
>
>   RetVal = CloseClipboard()
>   GetTextData = MyString
>
>End Function
>
>Sub SetTextData(MyString As String)
>   Dim hGlobalMemory As Long, lpGlobalMemory As Long
>   Dim hClipMemory As Long, x As Long
>
>   ' Allocate movable global memory.
>   '-------------------------------------------
>   hGlobalMemory = GlobalAlloc(GHND, Len(MyString) + 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, MyString)
>
>   ' Unlock the memory.
>   If GlobalUnlock(hGlobalMemory) <> 0 Then
>      MsgBox "Could not unlock memory location. Copy aborted.", ,
>"Clipboard"
>   Else
>      ' Open the Clipboard to copy data to.
>      If OpenClipboard(0&) = 0 Then
>         MsgBox "Could not open the Clipboard. Copy aborted.", , "Clipboard"
>         Exit Sub
>      End If
>   
>      ' Clear the Clipboard.
>      x = EmptyClipboard()
>   
>      ' Copy the data to the Clipboard.
>      hClipMemory = SetClipboardData(CF_TEXT, hGlobalMemory)
>   End If
>
>   If CloseClipboard() = 0 Then
>      MsgBox "Could not close Clipboard.", , "Clipboard"
>   End If
>
>End Sub
>   
>'********************************************
>  
>

-- 
Marty Connelly
Victoria, B.C.
Canada