Runtime error when using DataObject.PutInClipboard Method

Question

I have a macro that runs in my PC. When someone else runs it, it throws the following exception:

"Run-time error '-2147221036 (800401d4)'
DataObject:PutInClipboard CloseClipboard Failed"

Here is my code:

Dim buf As String, FSO As Object
Dim CB As New DataObject

Set FSO = CreateObject("Scripting.FileSystemObject")
With FSO.OpenTextFile(sFile, 1)
    buf = .ReadAll
    buf = Replace(buf, ",", Chr(9))
    .Close
End With

With CB
    .SetText buf
    .PutInClipboard   // Here cause the exception.
End With

Answer 1

I had the same problem. I don't know what causes it; my guess is that if your PC's resources are taxed, the Clipboard may not perform as quickly as you would like. My solution was to put the code in a loop and break when it works.

Dim buf As String, FSO As Object
Dim CB As New DataObject
dim errnum as long
dim errdesc as string
dim i as long

Set FSO = CreateObject("Scripting.FileSystemObject")
With FSO.OpenTextFile(sFile, 1)
    buf = .ReadAll
    buf = Replace(buf, ",", Chr(9))
    .Close
End With

With CB
    .SetText buf

    On Error Resume Next
        For i=1 to 200
            .PutInClipboard
            errnum = Err.Number
            errdesc = Err.Description
            If errnum = 0 Then Exit For
        Next i
    On Error Goto 0

    If errnum > 0 Then
        ' Do something to handle an epic failure... didn't work even after
        ' 200 tries.
        Err.Raise errnum, errdesc
    End If

End With

I had to do the same thing with Worksheet.PasteSpecial.