Microsoft Access: VBA Programming Code

Provided by Allen Browne, allenbrowne.com, based on code supplied by Ken Getz.

Text2Clipboard(), Clipboard2Text() - 16-bit functions.

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)

16-bit Declarations (for Access 1, 2): (32-bit versions also available.)

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