Excel VBA DataObject:PutInClipboard Not Implemented

Question

I maintain an Excel workbook with a bunch of VBA macros in it. The workbook has been in use for the past few months, mostly without any incident. We have a VBA function that is used to call other VBA functions. The purpose of it is to back up clipboard data, run the function, then restore clipboard data. It's pretty simple.

Sub FunctionHandler()
    Dim clipboardData As New DataObject
    clipboardData.GetFromClipboard

    '' There are a dozen or so macros that can be called here
    Call AnyFunction() 

    On Error Resume Next
    clipboardData.PutInClipboard
    On Error GoTo 0
End Sub

The VBA project includes a reference to Microsoft Forms 2.0 Object Library (FM20.DLL), which is needed to use the DataObject class.

On everyone's computer except mine, the function works as it should. It backs up the clipboard data, runs the function, and restores the clipboard contents.

The issue is only occurring on my computer. Whenever I run this function, and I have an empty clipboard, or plain text copied to the clipboard (it could be copied from excel or from an outside source like notepad), an error is thrown. The text of the error is

Run-time error '-2147467263 (80004001)':

DataObject:PutInClipboard Not implemented.

The error is thrown on the line clipboardData.PutInClipboard. It is never thrown the call to clipboardData.GetFromClipboard. Which to me means that the reference to the Microsoft Forms 2.0 Object Library is not having any issues.

The error is also not thrown if I copy a cell or range to the clipboard before running this macro. Only when the clipboard is empty or contains plain text data.

The error has never popped up on anyone else's computer at my job. I have made sure that the FM20.DLL exists in the correct folder on my computer. I have restarted Excel and my computer but the issue persists.

I get the same error when I reduce the code down to this.

Sub FunctionHandler()
    Dim clipboardData As New DataObject
    clipboardData.GetFromClipboard

    clipboardData.PutInClipboard
End Sub

I also have multiple full backup copies of the workbook, and every single backup that has this function is giving me the same issues (but again, only me).

Does anyone know how I can fix this?

EDIT: This issue does not happen when using a new Windows profile on my computer.

Answer 1

I faced a similar issue a while ago, these are the best solutions I came across to do what you want (a) may save some formats and some other useful things, b) only strings) I can see 2 scenarios here (and their solutions/workarounds):
a)You just need to save the data (but you are not clearing the clipboard at any moment in your routines).
In a stand alone module do the following:

Option Explicit
Private Declare Function OpenClipboard Lib "User32" _
(ByVal hwnd As Long) As Long
Private Declare Function CloseClipboard Lib "User32" () As Long
Sub SaveClipBoardContents()
    OpenClipboard 0
    CloseClipboard
End Sub
Sub ClearClipBoardContents()
    Application.CutCopyMode = False
End Sub

Change in your sub accordingly

Sub FunctionHandler()
    Call SaveClipBoardContents

    '' There are a dozen or so macros that can be called here
    Call AnyFunction() 
    'clipboard will reamain because of the sub SaveClipBoardContents
End Sub

b) You are clearing the Data (or using the clipboard on it) and would like to preserve the original one (if any). This is a slightly modified code from the one in Microsoft help to handle errors. Same logic, paste it standalone in a module.

Declare Function OpenClipboard Lib "User32" (ByVal hwnd As Long) _
   As Long
Declare Function CloseClipboard Lib "User32" () As Long
Declare Function GetClipboardData Lib "User32" (ByVal wFormat As _
   Long) As Long
Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags&, ByVal _
   dwBytes As Long) As Long
Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) _
   As Long
Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) _
   As Long
Declare Function GlobalSize Lib "kernel32" (ByVal hMem As Long) _
   As Long
Declare Function lstrcpy Lib "kernel32" (ByVal lpString1 As Any, _
   ByVal lpString2 As Any) As Long
Public Const GHND = &H42
Public Const CF_TEXT = 1
Public Const MAXSIZE = 4096
Function ClipBoard_GetData()
   Dim hClipMemory As Long
   Dim lpClipMemory As Long
   Dim MyString As String
   Dim RetVal As Long
   If OpenClipboard(0&) = 0 Then: MsgBox "Cannot open Clipboard. Another app. may have it open": Exit Function
   ' Obtain the handle to the global memory
   ' block that is referencing the text.
   hClipMemory = GetClipboardData(CF_TEXT)
   If IsNull(hClipMemory) Then GoTo OutOfHere

   ' Lock Clipboard memory so we can reference
   ' the actual data string.
   lpClipMemory = GlobalLock(hClipMemory)

   If Not IsNull(lpClipMemory) Then
      MyString = Space$(MAXSIZE)
      RetVal = lstrcpy(MyString, lpClipMemory)
      RetVal = GlobalUnlock(hClipMemory)
      ' Peel off the null terminating character.
      On Error GoTo OutOfHere
      MyString = Mid(MyString, 1, InStr(1, MyString, Chr$(0), 0) - 1)
   Else
      MsgBox "Could not lock memory to copy string from."
   End If
OutOfHere:
   RetVal = CloseClipboard()
   ClipBoard_GetData = IIf(MyString = "OutOfHere", "", MyString)
End Function

Change in your sub as well

Sub FunctionHandler()
    Dim DataClipBoard As String
    Dim clipboardData As DataObject
    DataClipBoard = ClipBoard_GetData
    '...
    Application.CutCopyMode = False ' to simulate if clipboard is lost at some point
    '...
    Set clipboardData = New DataObject
    With clipboardData
        .SetText DataClipBoard
        .PutInClipboard
    End With
End Sub

Note: Reference "FM20.dll" is the same one that I used for this testing. More info at Microsoft
EDIT:
Workaround to copy margins,colors, when using b) method

Sub FunctionHandler()
    Dim DataClipBoard As String
    Dim clipboardData As DataObject
    Dim RangeCopied As Range
    Set RangeCopied = Selection
    DataClipBoard = ClipBoard_GetData
    '...
    Application.CutCopyMode = False ' to simulate if clipboard is lost at some point
    '...
    If Not (RangeCopied.Find(Application.WorksheetFunction.Clean(Trim(Split(DataClipBoard, Chr(10))(1)))) Is Nothing) Then 'this is going to check if the data gathered in the copied clipboard is in the original selection, if so, this means this came from excel ' 1. If Not (RangeCopied.Find(Application.WorksheetFunction.Clean(Trim(Split(DataClipBoard, Chr(10))(1)))) Is Nothing) Then
    RangeCopied.Copy
    Else ' The data in clipboard didn't come from excel, so, just copy as plain text ' 1. If Not (RangeCopied.Find(Application.WorksheetFunction.Clean(Trim(Split(DataClipBoard, Chr(10))(1)))) Is Nothing) Then
    Set clipboardData = New DataObject
    With clipboardData
        .SetText DataClipBoard
        .PutInClipboard
    End With
    Set clipboardData = Nothing 'releases memory, data remain in CB
    End If ' 1. If Not (RangeCopied.Find(Application.WorksheetFunction.Clean(Trim(Split(DataClipBoard, Chr(10))(1)))) Is Nothing) Then
End Sub

More info if this doesn't fit your needs here, here and here.

Answer 2

I cant answer why you have the problem, but if it's only failing in putting in the clipboard you could try and exchange only that part for the below. It only handles strings so it might not do it for you.

Sub PutDataInClipBoard(intext As String)
    Dim objShell As Object
    Set objShell = CreateObject("WScript.Shell")
    objShell.Run "cmd /C echo|set/p=" & intext & "| CLIP", 2
End Sub

Answer 3

In an attempt to work-around the strange dependency issue you face, can you try replace the early-binding code with late-binding equivalent?

Example usage - note the magic number that refers to the MSForms 2.0 Object Library:

Option Explicit

Sub Test()

    ' set clipboard and test by pasting to range
    SetClipboard "hello world"
    Sheet1.Range("A1").PasteSpecial Paste:=xlPasteAll

End Sub

Sub SetClipboard(strToSet As String)

    Dim objDataObject As Object

    ' get clipboard with late binding
    Set objDataObject = CreateObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")

    ' set input string to clipboard
    With objDataObject
        .SetText strToSet
        .PutInClipboard
    End With

    ' clean up    
    Set objDataObject = Nothing

End Sub