Per Gary:
I have had a look and it looks very interesting, but there is nothing
on that page which actually tells you how to use that function - so I'm
struggling to get it to do anything at the moment-
Here's what I'm using (courtesy of Dev Asish)
--------------------------------------
Option Compare Database
Option Explicit
' Routines to put things into ('stuff') and get things from Windows' clipboard
'
' This code courtesy of Dev Asish:
http://www.mvps.org/access/api/api0049.htm
' It has been altered to fit Pete's standards - including addition of error
trapping,
' so if it doesn't work, don't blame Dev....
Private Const mModuleName = "basClipBoard"
Private Const GHND = &H42
Private 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 Function GetLastError Lib "kernel32" () 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 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
Private Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" (ByVal lpString
As String) As Long
Private Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As
Long
Private Declare Function OpenClipboard Lib "User32" (ByVal hWnd As Long) As Long
Private Declare Function CloseClipboard Lib "User32" () As Long
Private Declare Function GetClipboardData Lib "User32" (ByVal wFormat As Long)
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
Public Function ClipBoard_StuffText(theString As String) As Boolean
debugStackPush mModuleName & ": ClipBoard_StuffText"
On Error GoTo ClipBoard_StuffText_err
' PURPOSE: To stuff text into Windows' clipboard
' ACCEPTS: Text to be stuffed
' RETURNS: True/False depending on success
Dim hGlobalMemory As Long
Dim lpGlobalMemory As Long
Dim hClipMemory As Long
' Allocate moveable global memory.
'-------------------------------------------
hGlobalMemory = GlobalAlloc(GHND, Len(theString) + 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, theString)
' 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_StuffText = CBool(CloseClipboard)
End If
End If
ClipBoard_StuffText_xit:
DebugStackPop
On Error Resume Next
Exit Function
ClipBoard_StuffText_err:
BugAlert True, ""
Resume ClipBoard_StuffText_xit
End Function
Public Function ClipBoard_GetText() As String
1000 debugStackPush mModuleName & ": ClipBoard_GetText"
1001 On Error GoTo ClipBoard_GetText_err
' PURPOSE: To retreive clipboard's contents as text
' RETURNS: Tab/CRLF delimited text file containing contents of clipboard
1002 Dim hClipMem As Long
Dim hClipDat As Long
Dim myClipText As String
Dim L As Long
1010 If OpenClipboard(0&) <> 0 Then
1020 hClipMem = GetClipboardData(CF_TEXT) 'Get handle to
pointer to Clipboard memory block
1030 If hClipMem <> 0 Then
1040 hClipDat = GlobalLock(hClipMem) 'Lock Clipboard,
getting pointer to actual data.
1050 If hClipDat = 0 Then
1051 BugAlert True, "Could not lock clipboard."
1052 Else
1053 L = GlobalSize(hClipDat) 'Determine size of
data in clipboard
1054 myClipText = Space$(L)
1055 lstrcpy myClipText, hClipDat 'Copy data from
clipboard to local variable
1059 myClipText = Left(myClipText, InStr(1, myClipText, Chr$(0), 0) - 1)
'Strip null terminating character.
1060 GlobalUnlock hClipMem
1079 End If
1100 End If
1200 CloseClipboard
1300 End If
1999 ClipBoard_GetText = myClipText
ClipBoard_GetText_xit:
DebugStackPop
On Error Resume Next
Exit Function
ClipBoard_GetText_err:
BugAlert True, ""
Resume ClipBoard_GetText_xit
End Function
