Provided by Allen Browne. Last updated: April 2010.
To collect data from an Access form for pasting to your your word processor, how about a double-click on the form's detail section? The code for the DblClick event will be something like this:
Dim strOut as string strOut = Me.Title & " " & Me.FirstName & " " & Me.Surname & vbCrLf & _ Me.Address & vbCrLf & Me.City & " " & Me.State & " " & Me.Zip Text2Clipboard(strOut)
Notes:
This code will require modification if you use the 64-bit version of Office (not merely a 64-bit version of Windows.)
Access 2007 and later support introduced Rich Text memo fields that contain embedded HTML tags. The Text2Clipboard() function copies the tags, and then the appear literally when you paste them. To avoid this situation, use the PlainText() function. In the example above, you would use:
Text2Clipboard(PlainText(strOut))
Declare Function abOpenClipboard Lib "User32" Alias "OpenClipboard" (ByVal Hwnd As Long) As Long Declare Function abCloseClipboard Lib "User32" Alias "CloseClipboard" () As Long Declare Function abEmptyClipboard Lib "User32" Alias "EmptyClipboard" () As Long Declare Function abIsClipboardFormatAvailable Lib "User32" Alias "IsClipboardFormatAvailable" (ByVal wFormat As Long) As Long Declare Function abSetClipboardData Lib "User32" Alias "SetClipboardData" (ByVal wFormat As Long, ByVal hMem As Long) As Long Declare Function abGetClipboardData Lib "User32" Alias "GetClipboardData" (ByVal wFormat As Long) As Long Declare Function abGlobalAlloc Lib "Kernel32" Alias "GlobalAlloc" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long Declare Function abGlobalLock Lib "Kernel32" Alias "GlobalLock" (ByVal hMem As Long) As Long Declare Function abGlobalUnlock Lib "Kernel32" Alias "GlobalUnlock" (ByVal hMem As Long) As Boolean Declare Function abLstrcpy Lib "Kernel32" Alias "lstrcpyA" (ByVal lpString1 As Any, ByVal lpString2 As Any) As Long Declare Function abGlobalFree Lib "Kernel32" Alias "GlobalFree" (ByVal hMem As Long) As Long Declare Function abGlobalSize Lib "Kernel32" Alias "GlobalSize" (ByVal hMem As Long) As Long 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 Long Dim lpMemory As Long Dim retval As Variant Dim wFreeMemory As Boolean ' Get the length, including one extra for a CHR$(0) at the end. wLen = Len(szText) + 1 szText = szText & Chr$(0) hMemory = abGlobalAlloc(GHND, wLen + 1) If hMemory = APINULL Then MsgBox "Unable to allocate memory." Exit Function End If wFreeMemory = True lpMemory = abGlobalLock(hMemory) If lpMemory = APINULL Then MsgBox "Unable to lock memory." GoTo T2CB_Free End If ' Copy our string into the locked memory. retval = abLstrcpy(lpMemory, szText) ' Don't send clipboard locked memory. retval = abGlobalUnlock(hMemory) If abOpenClipboard(0&) = APINULL Then MsgBox "Unable to open Clipboard. Perhaps some other application is using it." GoTo T2CB_Free End If If abEmptyClipboard() = APINULL Then MsgBox "Unable to empty the clipboard." GoTo T2CB_Close End If If abSetClipboardData(CF_TEXT, hMemory) = APINULL Then MsgBox "Unable to set the clipboard data." GoTo T2CB_Close End If wFreeMemory = False T2CB_Close: If abCloseClipboard() = APINULL Then MsgBox "Unable to close the Clipboard." End If If wFreeMemory Then GoTo T2CB_Free Exit Function T2CB_Free: If abGlobalFree(hMemory) <> APINULL Then MsgBox "Unable to free global memory." End If End Function
To paste from the clipboard:
Function Clipboard2Text() Dim wLen As Integer Dim hMemory As Long Dim hMyMemory As Long Dim lpMemory As Long Dim lpMyMemory As Long Dim retval As Variant Dim wFreeMemory As Boolean Dim wClipAvail As Integer Dim szText As String Dim wSize As Long If abIsClipboardFormatAvailable(CF_TEXT) = APINULL Then Clipboard2Text = Null Exit Function End If If abOpenClipboard(0&) = APINULL Then MsgBox "Unable to open Clipboard. Perhaps some other application is using it." GoTo CB2T_Free End If hMemory = abGetClipboardData(CF_TEXT) If hMemory = APINULL Then MsgBox "Unable to retrieve text from the Clipboard." Exit Function End If wSize = abGlobalSize(hMemory) szText = Space(wSize) wFreeMemory = True lpMemory = abGlobalLock(hMemory) If lpMemory = APINULL Then MsgBox "Unable to lock clipboard memory." GoTo CB2T_Free End If ' Copy our string into the locked memory. retval = abLstrcpy(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 abCloseClipboard() = APINULL Then MsgBox "Unable to close the Clipboard." End If If wFreeMemory Then GoTo CB2T_Free Exit Function CB2T_Free: If abGlobalFree(hMemory) <> APINULL Then MsgBox "Unable to free global clipboard memory." End If End Function
Home | Index of tips | Top |