[Return to contents]

Example LotusScript: Copying calculated fields to the clipboard

Last updated: 16 Feb 2002

The following script was converted to LotusScript by Keith Seeley from Visual Basic routine contained in a Microsoft Office Developers article titled "Creating Reusable Class Modules" by Mike Gilbert (http://www.microsoft.com/officedev/articles/movs109.htm).

Keith writes: "Obviously this only works for a predefined field (hardwired into the sub). I use a function key, but anything that can trigger the sub will work. Also note that the error checking in the function is how I got it. Only recently have I been trying to design 'well behaved' apps with error checking, and this is not one of the routines I've gone through."

*****Declares
Declare Private Sub MoveMemory  Lib "kernel32" Alias "RtlMoveMemory" ( Byval strDest As Any, Byval lpSource As Any, Byval Length As Any)
Declare Private Function GlobalAlloc Lib "kernel32" (Byval uFlags As Long, Byval dwBytes As Long) As Long
Declare Private Function GlobalFree Lib "kernel32" (Byval hMem As Long) As Long
Declare Private Function GlobalLock Lib "kernel32" (Byval hMem As Long) As Long
Declare Private Function GlobalUnlock Lib "kernel32" (Byval hMem As Long) As Long
Declare Private Function OpenClipboard Lib "user32" (Byval hWnd As Long) As Long
Declare Private Function GetClipboardData Lib "user32" (Byval uFormat As Long) As Long
Declare Private Function CloseClipboard Lib "user32" () As Long
Declare Private Function EmptyClipboard Lib "user32" () As Long
Declare Private Function SetClipboardData Lib "user32" (Byval uFormat As Long, Byval hData As Long) As Long

'Clipboard Constants...
Private Const GMEM_MOVABLE = &H2&
Private Const GMEM_DDESHARE = &H2000&
Private Const CF_TEXT = 1
Private Const CANNOTOPENCLIPBOARD = 2
Private Const CANNOTGLOBALLOCK = 4
Private Const CANNOTCLOSECLIPBOARD = 5
Private Const CANNOTGLOBALALLOC = 6
Private Const CANNOTEMPTYCLIPBOARD = 7
Private Const CANNOTSETCLIPBOARDDATA = 8
Private Const CANNOTGLOBALFREE = 9

*****Copy Data Function
Function fSendToClipboard(strText As String) As Variant
        Dim varRet As Variant
        Dim fStClpData As Long
        Dim hMem As Long
        Dim lpMemory As Long
        Dim lngSize As Long
        Dim varTemp As Variant

        varRet = False
        fStClpData = False

        lngSize = Len(strText) + 1
        hMem = GlobalAlloc(GMEM_MOVABLE Or _
        GMEM_DDESHARE, lngSize)
        If  (hMem) =0 Or Isnull(hMem)Then
                varRet = Error(CANNOTGLOBALALLOC)
                Goto sTxtDone
        End If

        lpMemory = GlobalLock(hMem)
        If  (lpMemory) =0 Or Isnull(lpMemory) Then
                varRet = Error(CANNOTGLOBALLOCK)
                Goto sTxtGlblFree
        End If

        Call MoveMemory(lpMemory, strText, lngSize)

        Call GlobalUnlock(hMem)
        varTemp = (OpenClipboard(0&))
        If  varTemp=0 Or Isnull(varTemp) Then
                varRet = Error(CANNOTOPENCLIPBOARD)
                Goto sTxtGlblFree
        End If
        varTemp = (emptyClipboard())
        If  varTemp=0 Or Isnull(varTemp) Then
                varRet = Error(CANNOTEMPTYCLIPBOARD)
                Goto fSendToClipboardCloseClipboard
        End If
        varTemp = SetClipboardData(CF_TEXT, hMem)
        If  varTemp=0 Or Isnull(varTemp) Then
                varRet = Error(CANNOTSETCLIPBOARDDATA)
                Goto fSendToClipboardCloseClipboard
        Else
                fStClpData = True
        End If

fSendToClipboardCloseClipboard:
        varTemp = closeclipboard()
        If   varTemp=0 Or Isnull(varTemp) Then
                varRet = Error(CANNOTCLOSECLIPBOARD)
        End If

sTxtGlblFree:
        If Not fStClpData Then
                varTemp = globalfree(hmem)
                If  varTemp=0 Or Isnull(varTemp) Then
                        varRet = Error(CANNOTGLOBALFREE)
                End If
        End If

sTxtDone:
        fSendToClipboard = varRet
End Function

*****Representative Sub to copy the data
Sub CopyData
        Dim varRet As Variant
        Dim strText As String
        strText = currentview.body.calctest.text
        varRet =        fSendToClipboard(strText)
End Sub