Provided by Allen Browne, allen@allenbrowne.com, based on code supplied by Ken Getz.
To collect data from an Access form for pasting to your your word processor, how about a doubleclick on the form's detail section? The code for the DblClick event will be something like this:
Dim strOut as string, nl as string * 2, dummy nl = chr$(13) & chr$(10) ' new line strOut = [Title] & " " & [FirstName] & " " & [Surname] & nl strOut = strOut & [Address] & nl & [City] & " " & [Zip] dummy = Text2Clipboard(strOut)
Declare Function kngOpenClipboard Lib "User" Alias "OpenClipboard" (ByVal hWnd As Integer) As Integer Declare Function kngGlobalAlloc Lib "Kernel" Alias "GlobalAlloc" (ByVal wFlags As Integer, ByVal dwBytes As Long) As Integer Declare Function kngGlobalLock Lib "Kernel" Alias "GlobalLock" (ByVal hMem As Integer) As Long Declare Function kngGlobalUnlock Lib "Kernel" Alias "GlobalUnlock" (ByVal hMem As Integer) As Integer Declare Function kngCloseClipboard Lib "User" Alias "CloseClipboard" () As Integer Declare Function kngLstrcpy Lib "Kernel" Alias "lstrcpy" (ByVal lpString1 As Any, ByVal lpString2 As Any) As Long Declare Function kngEmptyClipboard Lib "User" Alias "EmptyClipboard" () As Integer Declare Function kngSetClipboardData Lib "User" Alias "SetClipboardData" (ByVal wFormat As Integer, ByVal hMem As Integer) As Integer Declare Function kngGlobalFree Lib "Kernel" Alias "GlobalFree" (ByVal hMem As Integer) As Integer Declare Function kngIsClipboardFormatAvailable Lib "USER" Alias "IsClipboardFormatAvailable" (ByVal wFormat As Integer) As Integer Declare Function kngGetClipboardData Lib "USER" Alias "GetClipboardData" (ByVal wFormat As Integer) As Integer Declare Function kngGlobalSize Lib "KERNEL" Alias "GlobalSize" (ByVal hMem As Integer) As Integer Const GHND = &H42 Const CF_TEXT = 1 Const APINULL = 0
To copy to the clipboard:
Function Text2ClipBoard (szText As String) Dim wLen As Integer Dim hMemory As Integer Dim lpMemory As Long Dim retval As Variant Dim wFreeMemory As Integer ' Get the length, including one extra for a CHR$(0) at the end. wLen = Len(szText) + 1 szText = szText & Chr$(0) hMemory = kngGlobalAlloc(GHND, wLen + 1) If hMemory = APINULL Then MsgBox "Unable to allocate memory." Exit Function End If wFreeMemory = True lpMemory = kngGlobalLock(hMemory) If lpMemory = APINULL Then MsgBox "Unable to lock memory." GoTo T2CB_Free End If ' Copy our string into the locked memory. retval = kngLstrcpy(lpMemory, szText) ' Don't send clipboard locked memory. retval = kngGlobalUnlock(hMemory) If kngOpenClipboard(0&) = APINULL Then MsgBox "Unable to open Clipboard. Perhaps some other application is using it." GoTo T2CB_Free End If If kngEmptyClipboard() = APINULL Then MsgBox "Unable to empty the clipboard." GoTo T2CB_Close End If If kngSetClipboardData(CF_TEXT, hMemory) = APINULL Then MsgBox "Unable to set the clipboard data." GoTo T2CB_Close End If wFreeMemory = False T2CB_Close: If kngCloseClipboard() = APINULL Then MsgBox "Unable to close the Clipboard." End If If wFreeMemory Then GoTo T2CB_Free Exit Function T2CB_Free: If kngGlobalFree(hMemory) <> APINULL Then MsgBox "Unable to free global memory." End If Exit Function End Function
To paste from the clipboard:
Function Clipboard2Text () Dim wLen As Integer Dim hMemory As Integer Dim hMyMemory As Integer Dim lpMemory As Long Dim lpMyMemory As Long Dim retval As Variant Dim wFreeMemory As Integer Dim wClipAvail As Integer Dim szText As String Dim wSize As Integer If kngIsClipboardFormatAvailable(CF_TEXT) = 0 Then Clipboard2Text = Null Exit Function End If If kngOpenClipboard(0&) = APINULL Then MsgBox "Unable to open Clipboard. Perhaps some other application is using it." GoTo CB2T_Free End If hMemory = kngGetClipboardData(CF_TEXT) If hMemory = APINULL Then MsgBox "Unable to retrieve text from the Clipboard." Exit Function End If wSize = kngGlobalSize(hMemory) szText = Space(wSize) wFreeMemory = True lpMemory = kngGlobalLock(hMemory) If lpMemory = APINULL Then MsgBox "Unable to lock clipboard memory." GoTo CB2T_Free End If ' Copy our string into the locked memory. retval = kngLstrcpy(szText, lpMemory) ' Get rid of trailing stuff. szText = Trim(szText) ' Get rid of trailing 0. Clipboard2Text = Left(szText, Len(szText) - 1) wFreeMemory = False CB2T_Close: If kngCloseClipboard() = APINULL Then MsgBox "Unable to close the Clipboard." End If If wFreeMemory Then GoTo CB2T_Free Exit Function CB2T_Free: If kngGlobalFree(hMemory) <> APINULL Then MsgBox "Unable to free global clipboard memory." End If Exit Function End Function
Home | Index of tips | Top |