使用DataObject.PutInClipboard方法时出现运行时错误

时间:2012-07-19 04:41:59

标签: vba clipboard

我有一个在我的电脑上运行的宏。当其他人运行它时,它会抛出以下异常:

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

这是我的代码:

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

2 个答案:

答案 0 :(得分:2)

我遇到了同样的问题。我不知道是什么原因造成的;我的猜测是,如果您的PC资源被征税,剪贴板可能无法按照您的意愿执行。我的解决方案是将代码放在一个循环中,并在它工作时中断。

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

我必须对Worksheet.PasteSpecial做同样的事情。

答案 1 :(得分:0)

我在Windows 10(64位),Word 2003中遇到了同样的错误。当我使用时,错误消失了:

.Clear

即。之前就已经清除了DataObject:

.SetText

编辑:也适用于Windows 10(32位),Word 2013