Questions similar to this appear on the Be Communities MicroStation Programming Forum.

Q  As users of the world's most used operating system, we cut and paste every day. As computer users we are familiar with the Windows clipboard and therefore appreciate how it might in turn benefit the users of our programs.

If you've wondered how to use the clipboard in VBA you'll have run into one of those little hurdles Microsoft likes to put in our path: the clipboard is not included with VBA. MicroStation CONNECT delivered 64-bit VBA version 7.1. Unfortunately the relatively simple approach we were able to use with 32-bit VBA no longer works: we must make some calls to the Win32 API.

A  VBA does not include a Clipboard object (even though pure Visual Basic does include one). This isn't some aberration of MicroStation VBA: it's missing from all VBA implementations because they are derived from the same Microsoft toolkit. However, the down-and-dirty Windows application programming interface (Win32 API) does include clipboard functions. As a VBA programmer your task is to figure out how to use the Win32 API to accomplish your goal.

This solution is more-or-less duplicated from code published by Karl E. Peterson, to whom full acknowledgement is given.

Because VBA doesn't provide a Clipboard object, we create our own class that behaves programmatically in a similar fashion. The guts of the class call the Win32 API directly, shielding the VBA caller from the ugly details. Here's how you might use this class …

Function ClipboardAsDouble() As Double
    ClipboardAsDouble = 0#
    On Error GoTo err_ClipboardAsDouble
    Dim oClipboard As New clsClipboard   '  Our own clipboard class
    ClipboardAsDouble = CDbl(oClipboard.GetText)
    Debug.Print "Clipboard=" & CStr(CDbl(oClipboard.GetText))
    Exit Function

err_ClipboardAsDouble:
    MsgBox "Error no. " & CStr(Err.Number) & ": " & Err.Description, vbCritical Or vbOKOnly, "Error in ClipboardAsDouble"
End Function

Clipboard Class

Here's the clipboard class source code. To use this, first create a new VBA class module clsClipboard, then copy-and-paste this code into your new class.


Option Explicit
' --------------------------------------------------------------------
Private Const sMODULE_NAME                  As String = "clsClipboard"
' --------------------------------------------------------------------
'   VBA doesn't provide any method to get or set data in the Windows
'   Clipboard.  This class provides some basic methods for Clipboard
'   operation.
' --------------------------------------------------------------------
'   Notice:
'   This example code is provided as-is by LA Solutions Ltd with no
'   warranty of fitness for purpose and with no support.  This
'   example is derived from published information found at this URL:
'   http://vb.mvps.org/articles/ap200106.asp
'
'   You are free to use and adapt this code for personal or commercial use
'   provided that this notice is retained in full
'   End of notice
' --------------------------------------------------------------------
' Clipboard Manager Functions
' --------------------------------------------------------------------
Private Declare PtrSafe Function OpenClipboard Lib "user32" (ByVal hwnd As LongPtr) As Long
Private Declare PtrSafe Function CloseClipboard Lib "user32" () As Long
Private Declare PtrSafe Function EmptyClipboard Lib "user32" () As Long
Private Declare PtrSafe Function SetClipboardData Lib "user32" (ByVal wFormat As Long, ByVal hMem As LongPtr) As LongPtr
Private Declare PtrSafe Function GetClipboardData Lib "user32" (ByVal wFormat As Long) As LongPtr

Private Declare PtrSafe Function IsClipboardFormatAvailable Lib "user32" (ByVal wFormat As Long) As Long

Private Declare PtrSafe Function GetPriorityClipboardFormat Lib "user32" (lpPriorityList As Long, ByVal nCount As Long) As Long

Declare PtrSafe Function EnumClipboardFormats Lib "user32" (ByVal wFormat As Long) As Long
' --------------------------------------------------------------------
' Other useful APIs
' --------------------------------------------------------------------

Private Declare PtrSafe Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As LongPtr) As LongPtr
Private Declare PtrSafe Function GlobalFree Lib "kernel32" (ByVal hMem As LongPtr) As LongPtr
Private Declare PtrSafe Function GlobalLock Lib "kernel32" (ByVal hMem As LongPtr) As LongPtr
Private Declare PtrSafe Function GlobalSize Lib "kernel32" (ByVal hMem As LongPtr) As LongPtr
Private Declare PtrSafe Function GlobalUnlock Lib "kernel32" (ByVal hMem As LongPtr) As Long

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pTo As Any, uFrom As Any, ByVal lSize As Long)
Private Declare PtrSafe Function lstrcpy Lib "kernel32" (ByVal lpString1 As Any, ByVal lpString2 As Any) As LongPtr
' --------------------------------------------------------------------
Private Const GMEM_FIXED                    As Long = &H0
' --------------------------------------------------------------------
' Predefined Clipboard Formats
' --------------------------------------------------------------------
Private Const CF_TEXT                       As Long = 1
Private Const CF_BITMAP                     As Long = 2
Private Const CF_METAFILEPICT               As Long = 3
Private Const CF_SYLK                       As Long = 4
Private Const CF_DIF                        As Long = 5
Private Const CF_TIFF                       As Long = 6
Private Const CF_OEMTEXT                    As Long = 7
Private Const CF_DIB                        As Long = 8
Private Const CF_PALETTE                    As Long = 9
Private Const CF_PENDATA                    As Long = 10
Private Const CF_RIFF                       As Long = 11
Private Const CF_WAVE                       As Long = 12
Private Const CF_UNICODETEXT                As Long = 13
Private Const CF_ENHMETAFILE                As Long = 14
Private Const CF_HDROP                      As Long = 15
Private Const CF_LOCALE                     As Long = 16
Private Const CF_MAX                        As Long = 17
Private Const CF_OWNERDISPLAY               As Long = &H80
Private Const CF_DSPTEXT                    As Long = &H81
Private Const CF_DSPBITMAP                  As Long = &H82
Private Const CF_DSPMETAFILEPICT            As Long = &H83
Private Const CF_DSPENHMETAFILE             As Long = &H8E
' --------------------------------------------------------------------
'  Public Methods
' --------------------------------------------------------------------
Public Function GetFormat(ByVal Format As Long) As Boolean
   ' Check if the requested format is available
   ' on the clipboard. (Same behavior as standard
   ' VB Clipboard object)
   If OpenClipboard(0&) Then
      If IsClipboardFormatAvailable(Format) Then
         GetFormat = True
      End If
      Call CloseClipboard
   End If
End Function
' --------------------------------------------------------------------
Public Function GetPriorityFormat(ParamArray Formats()) As Long
   Dim Fmts() As Long
   Dim i As Long
   Dim nFmt As Long

   ' Bail, if no formats were requested
   If UBound(Formats) < 0 Then Exit Function

   ' Transfer desired formats into a non-variant array
   ReDim Fmts(0 To UBound(Formats)) As Long
   For i = 0 To UBound(Formats)
      ' Double conversion, to be safer.
      ' Could error trap, but that'd mean the
      ' user was a hoser, and we wouldn't want
      ' to insinuate *that*, would we? 
      Fmts(i) = CLng(Val(Formats(i)))
   Next i

   ' Try opening clipboard...
   If OpenClipboard(0&) Then
      ' Check to see which format is highest in list
      nFmt = GetPriorityClipboardFormat(Fmts(0), UBound(Fmts) + 1)
      Call CloseClipboard
   Else
      ' Clipboard may already be open by another
      ' routine in same process, try anyway to see
      ' if we can get a successful result.  Not
      ' clean, but worth a shot
      nFmt = GetPriorityClipboardFormat(Fmts(0), UBound(Fmts) + 1)
   End If

   ' Return results
   GetPriorityFormat = nFmt
End Function
' --------------------------------------------------------------------
Public Function GetText() As String
   Dim nFmt As Long
   Dim hData As Long
   Dim lpData As Long

   ' Check for desired format
   nFmt = Me.GetPriorityFormat(CF_TEXT, CF_OEMTEXT, CF_DSPTEXT)

   ' -1=None requested, 0=Empty
   If nFmt > 0 Then
      ' Grab text from clipboard, if available
      If OpenClipboard(0&) Then
         hData = GetClipboardData(nFmt)
         ' Slurp characters from global memory
         If hData Then
            lpData = GlobalLock(hData)
               GetText = PointerToStringA(lpData)
            Call GlobalUnlock(hData)
         End If
         Call CloseClipboard
      End If
   End If
End Function
' --------------------------------------------------------------------
Public Function SetText(ByVal NewVal As String) As Boolean
   Dim hData As Long
   Dim lpData As Long
   Dim Buffer() As Byte

   ' Try to set text onto clipboard
   If OpenClipboard(0&) Then
      ' Convert data to ANSI byte array
      Buffer = StrConv(NewVal & vbNullChar, vbFromUnicode)
      ' Allocate enough memory for buffer
      hData = GlobalAlloc(GMEM_FIXED, UBound(Buffer) + 1)
      If hData Then
         ' Copy data to alloc'd memory
         lpData = GlobalLock(hData)
         Call CopyMemory(ByVal lpData, Buffer(0), UBound(Buffer) + 1)
         Call GlobalUnlock(hData)
         ' Hand data off to clipboard
         SetText = CBool(SetClipboardData(CF_TEXT, hData))
      End If
      Call CloseClipboard
   End If
End Function
' --------------------------------------------------------------------
'  Private Methods
' --------------------------------------------------------------------
Private Function PointerToStringA(ByVal lpStringA As Long) As String
   Dim Buffer() As Byte
   Dim nLen As Long

   If lpStringA Then
      nLen = lstrlenA(ByVal lpStringA)
      If nLen Then
         ReDim Buffer(0 To (nLen - 1)) As Byte
         CopyMemory Buffer(0), ByVal lpStringA, nLen
         PointerToStringA = StrConv(Buffer, vbUnicode)
      End If
   End If
End Function