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

我有一个运行在我的PC上的宏。当别人运行它，它会引发以下异常：使用DataObject.PutInClipboard时出现运行时错误方法

"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

来源

2012-07-19 shenhengbin

您的代码适用于我。正如我所料，我想。当我使用API调用来访问剪贴板，然后尝试使用'PutInClipboard'方法时，我遇到了类似的错误。 – mkingston 2012-07-19 05:03:56

@mkingston谢谢。赶上麻烦真的很难！ – shenhengbin 2012-07-19 05:20:26

是的，我可以相信它。祝你好运，对不起，我忍不住了。 – mkingston 2012-07-19 05:25:36

我有同样的问题。我不知道是什么原因造成的;我的猜测是，如果您的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做同样的事情。

来源

2015-06-15 21:09:31 livefree75

-1

我也遇到了同样的错误在Windows 10（64位），Word 2003中，当我使用了错误已经消失：

.Clear

即清除了数据对象，之前：

.SetText

编辑：也适用于Windows 10（32位），Word 2013

来源

2016-05-14 04:55:31 Appenzeller

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

回答

相关问题