VBA 数据对象的奇怪行为。 GetText 返回剪贴板上当前的内容

Question

我之前发布了一个关于从 Microsoft Office Excel 2013 VBA 访问的 MSForms DataObject 引发的错误的问题。当我写那篇文章时，我发现了其他更令人担忧的奇怪行为。

也许我对 DataObject 的看法是错误的，但如果是这样，MS Office 文档就会非常具有误导性。我的期望是：

如果我创建一个 DataObject 并使用 GetFromClipboard 方法，它应该将剪贴板上的任何内容加载到对象中。存储在对象中的数据应该不更改，直到我对对象执行一些其他操作（例如调用 Clear、SetText 等）

所以如果我执行以下操作：

1. 手动将一些文本复制到 Windows 剪贴板上。
2. 创建一个 DataObject 并调用 GetFromClipboard
3. 执行一些更改窗口剪贴板的 VBA 操作（但不访问 DataObject）
4. 在 DataObject 上调用 GetText

我会预计我在步骤 4 中检索到的文本与我在 #2 中放置的文本相同。

但是，情况并非如此，如下面的示例代码所示。

测试说明：

1. 将此代码复制到办公应用程序中的标准代码模块中。
2. 复制一些文本（例如从记事本）
3. 运行方法“TestDataObject”
4. 出现提示时，复制一些不同的文本。
5. 当第二次出现提示时，复制一些其他不同的文本。

（您可能需要添加对“Microsoft Forms 2.0 对象库”的引用，只需将 UserForm 添加到 VBA 项目即可快速完成，因为这会自动添加引用）

'Copy some text before running this.
Public Sub TestDataObject()
    Dim oData As DataObject
    Set oData = New DataObject

    'This is BEFORE GetFromClipboard is called, so 
    ' the DataObject currently has NO text in it.
    If oData.GetFormat(1) Then
        Debug.Print "1) Contents: " & oData.GetText(1)
    Else
        'This line will be printed.
        Debug.Print "1) Contents: (NONE)"
    End If

    oData.GetFromClipboard

    'Now the DataObject has some text, and it will be printed below.
    If oData.GetFormat(1) Then Debug.Print "2) Contents: " & oData.GetText(1)

    MsgBox "Copy some Text"

    'If you copied NEW text, then it will be shown below (instead of the original data)
    If oData.GetFormat(1) Then Debug.Print "3) Contents: " & oData.GetText(1)

    MsgBox "Copy some different Text"

    'If you copied other NEW text, then it will be shown below (instead of the original data)    
    If oData.GetFormat(1) Then Debug.Print "4) Contents: " & oData.GetText(1)

End Sub

假设我在运行 sub 之前复制的文本是“Hello”，我期望这会打印出以下内容，不管我手动复制的内容是什么运行：

1) Contents: (NONE)
2) Contents: Hello
3) Contents: Hello
4) Contents: Hello

但实际输出是这样的：

1) Contents: (NONE)
2) Contents: Hello
3) Contents: World
4) Contents: Goodbye

（假设我第一次提示时复制了“世界”，第二次提示时复制了“再见”。）

请注意，Msgbox 不会导致此行为。如果您愿意，您可以使用 DoEvents-Loop 几秒钟。或者使用 Range 对象或其他 Excel 对象执行复制/粘贴操作，如下所示：

Public Sub TestDataObject()
    Dim oData As DataObject: Set oData = New DataObject

    ThisWorkbook.ActiveSheet.Range("A1").Select
    Selection.Value = "Hello"
    Selection.Copy

    If oData.GetFormat(1) Then
        Debug.Print "1) Contents: " & oData.GetText(1)
    Else
        Debug.Print "1) Contents: (NONE)"
    End If

    oData.GetFromClipboard

    If oData.GetFormat(1) Then Debug.Print "2) Contents: " & oData.GetText(1)
    Selection.Value = "World"
    Selection.Copy
    If oData.GetFormat(1) Then Debug.Print "3) Contents: " & oData.GetText(1)
    Selection.Value = "Goodbye"
    Selection.Copy
    If oData.GetFormat(1) Then Debug.Print "4) Contents: " & oData.GetText(1)
End Sub

这不是 Excel 特有的。相同的代码在 Word 中工作，除了您必须将选择/复制代码更改为此（例如）：

' Code to copy text in Word
Selection.Text = "World"
Selection.Copy

所以我的问题是：这种行为是预期的还是错误？我正在使用 Office 2014 64 位。这是否也发生在 32 位 Office 中？也许这只是一个 64 位错误。

谢谢！

Answer 1

我可以复制（32 位 Office 2010、Win7）

Sub Tester()
Dim d As New DataObject, d2 As New DataObject

    d2.SetText "first"
    d2.PutInClipboard

    d.GetFromClipboard
    Debug.Print d.GetText  '--> "first"

    d2.SetText "second"
    d2.PutInClipboard

    Debug.Print d.GetText  '--> "second"

    d2.SetText "third"
    d2.PutInClipboard

    Debug.Print d.GetText  '--> "third"

End Sub

我不得不猜测GetFromClipboard 仅通过引用 建立到剪贴板的链接，而不是通过值。因此，无论何时调用 GetText，它实际上都是直接从剪贴板中提取，而不是从 DataObject 中保存的复制缓存中提取。

如果您需要一个不受后续复制操作影响的剪贴板内容的稳定副本，那么您必须将其存储在（例如）字符串变量中。

Answer 2

我在使用 MS Access VBA 时遇到了类似的问题： 我的例程启动了一个软件，该软件会自动从智能手机的剪贴板中复制文本内容，然后循环，直到所需的文本在 pc 的剪贴板中可用。 文本（特殊账单格式）来自我智能手机上的二维码扫描应用程序。

但是，我总是遇到错误，有时是 DataObj.GetFromClipboard ，有时是 ClipText = DataObj.GetText(1) 。当我用 或 恢复该过程时，一切都运行了，没有任何错误。

' …
Dim ClipData As New DataObject          'object to use the clipboard
ClipData.SetText Text:="×××"
ClipData.PutInClipboard                 'overwriting old text contents
' …
Application.Echo (False)
On Error Resume Next
For WarteZeit = 1 To 80
    DataObj.GetFromClipboard                ' get data from the clipboard
    If DataObj.GetFormat(1) = True Then     ' Text im Clipboard
        ClipText = DataObj.GetText(1)       ' get clipboard contents
        If Left(ClipText, 3) = "SPC" And ((InStr(ClipText, Chr(10)) = 4) _
            Or (InStr(ClipText, Chr(13)) = 4)) Then
            Exit For
        End If
    End If
    Sleep 750                               ' 80 × 750 ms = 1 Minute
Next WarteZeit
On Error GoTo 0
Application.Echo (True)
' …

剪贴板显然很慢，多任务处理也很差。 当剪贴板处于活动状态从一个软件加载新数据时，它仍然包含旧数据或根本无法访问导致错误（没有 Windows 错误编号）。 上面的代码包含了我对问题的解决方案：只需耐心等待，并确保新内容已到达剪贴板，然后再调用它们。

Answer 3

Gruß Gott :-)

我想知道这里讨论的现象是否可以稍微不同的解释：

在我看来，数据对象和 Windows 剪贴板以某种方式非常紧密地联系在一起，但在某种程度上，也许没有人知道确切的信息，或者，那些知道的人并没有说出来，因为它是专有信息。此外，可能还有一些规则、编码或类似的东西来管理数据对象和 Windows 剪贴板如何处理不同剪贴板（Office、Windows、Excel 等）的意大利面条以及其中复制数据的不同版本。我怀疑在此期间是否有任何人能够解开意大利面条以明确理解它。 “剪贴板”这个怪物的一部分是真正的 OLE 对象，即数据对象。我们可以访问它。 我们的 Data 对象可能更像是一个监视 Windows 剪贴板的挂钩事件。我们可以设置可以使用的东西。我们可以通过 Data 对象影响剪贴板的行为

我的实验告诉我，有些寄存器我们无法直接访问，但我们可以影响它们，并且在某种程度上与窗口剪贴板中的内容密切相关。我认为我们只知道它的一些行为。 我在想.GetText() 返回最后添加到寄存器中的东西。

一些例子可以帮助解释奇怪的行为：

子复制()

此例程最初通过 Excel 范围副本填充 Office、Windows 和 Excel 剪贴板 .PutInClipboard 和 .GetText() 最初会失败，因为它们所引用的寄存器未填充。 .GetFromClipboard 现在以某种方式向数据对象中的寄存器添加了一些内容；我认为这是从 Windows 剪贴板获取数据。 我清除了 Office 和 Excel 剪贴板以证明它们没有在代码中进一步使用。但是我注意到在清除这些之前我必须执行.GetFromClipboard：在这种情况下清除 Office 或 Excel 剪贴板接缝以使 Windows 剪贴板为空。我不确定为什么会这样，除了剪贴板中依赖项的意大利面条在这个初始点以某种方式发挥作用###我认为我们通常不能通过清空 Windows 剪贴板来清空Office 或 Excel 剪贴板 .GetText() 现在给我复制单元格的值。但我相信这告诉我我上次添加到数据对象中的寄存器中的内容。 现在我使用 .SetText ，我相信我会再次向数据对象中的寄存器添加一些内容。 .GetText() 现在给了我我添加的文本，“新文本” 我建议在这一点上，在这个特定的代码中，我仍然有来自单元格的值来自剪贴板，并且它位于主寄存器中。我不太确定“新文本”在哪里/如何。 （在某些情况下，我看到这个“新文本”会用.PutInClipboard 替换 Windows 剪贴板中的文本。奇怪的是，这在这个例程中不会发生） 如果我此时尝试粘贴，则会出错。我认为这是合理的：此时我认为 Windows 剪贴板中没有数据。 ### 在此特定示例中，Windows 剪贴板已被清空 Office 或 Excel 剪贴板的代码行清空：通常情况并非如此### .PutInClipboard 代码行现在没有错误。
也没有粘贴几行。
可能没想到的是，粘贴的不是“新文本”，而是单元格中的原始文本 （还要注意，这次我们可以清除 Office 和 Excel 剪贴板——无论有没有这些行，结果都是一样的——代码行 ActiveSheet.Paste Destination:=ActiveSheet.Range("C1") 显然正在使用 Windows 剪贴板）

Option Explicit '   https://stackoverflow.com/questions/25091571/strange-behavior-from-vba-dataobject-gettext-returns-what-is-currently-on-the-c
' YOU NEED routine, ClearOffPainBouton() - get here, or just comment out Call s to it : --- https://pastebin.com/5bhqBAVx , http://www.eileenslounge.com/viewtopic.php?f=30&t=31849&start=20#p246838  http://www.excelfox.com/forum/showthread.php/2056-Appendix-Thread-(-Codes-for-other-Threads-HTML-Tables-etc-)?p=11019&viewfull=1#post11019   --- it will be best to copy entire coding here  to a seperate code module
Sub Copying()
Range("C1").Clear
Dim DtaObj As Object '  Late Binding equivalent'                                                                                    If you declare a variable as Object, you might be late binding it.  http://excelmatters.com/2013/09/23/vba-references-and-early-binding-vs-late-binding/   ... if you can ....  http://www.eileenslounge.com/viewtopic.php?f=30&t=31547&start=40#p246602
 Set DtaObj = GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")                                                             ' http://excelmatters.com/2013/10/04/late-bound-msforms-dataobject/
Let Range("A1").Value = "CellA1": Range("A1").Copy                ' This probably fills the Excel Clipboard, the Window Clipboard and the Office Clipboard
' DtaObj.PutInClipboard '                                         ' This will fail, DtaObj clear
' MsgBox Prompt:="DtaObj.GetText(1) is   " & DtaObj.GetText()     ' This will fail, DtaObj clear
 DtaObj.GetFromClipboard                                          '
 Let Application.CutCopyMode = False ' This clears the  Excel Clipboard
 Call ClearOffPainBouton             ' This clears the Office Clipboard
 MsgBox prompt:="DtaObj.GetText() is   " & DtaObj.GetText() '  --- "DtaObj.GetText() is  CellA1"
 DtaObj.SetText Text:="New Text" '
 MsgBox prompt:="DtaObj.GetText() is   " & DtaObj.GetText() '  --- "DtaObj.GetText() is  New Text"
' ActiveSheet.Paste Destination:=ActiveSheet.Range("C1")          ' This would error here
 DtaObj.PutInClipboard
 Let Application.CutCopyMode = False ' This clears the  Excel Clipboard
 Call ClearOffPainBouton             ' This clears the Office Clipboard
 ActiveSheet.Paste Destination:=ActiveSheet.Range("C1")     '  --- "CellA1"  is pasted in cell C1
End Sub

Sub Copying2() 这使最后一个 Sub 更进一步.. 这里是对编码的简短介绍

' 下面的新位 在接下来的 6 行中，我感觉 .PutInClipboard 和 .GetFromClipboard 没有做太多，如果有的话。可能 Excel 知道我没有更改任何数据，因此它会忽略尝试执行通常会应用于某些新数据的操作。

' 手动复制 系统会提示您复制任何内容。你应该做这个 紧接着，.GetText() 没有更改，但您现在粘贴了您复制的值。这再次表明代码行 ActiveSheet.Paste Destination:=ActiveSheet.Range("C1") 显然正在使用 Windows 剪贴板 使用 .GetFromClipboard 后，您现在会发现 .GetText() 返回您复制的值

尝试使用 .SetText 添加到 windows 剪贴板 我们设置文本（执行.SetText）并执行.PutInClipboard。但是正如我们所看到的，这并没有改变这种情况下的剪贴板，我们手动复制的最后一个东西仍然在那里被粘贴 我试试.Clear 接下来的两行会出错。这是有道理的：我已经清空了寄存器。第三行错误不太明显。它建议.Clear 清除Windows 剪贴板。我不确定是否会一直如此。 最后的代码行通过 .SetText 成功地向 Windows 剪贴板添加了一些东西。我的解释是，由于所有寄存器都是空的，因此通过.SetText 给出的值是唯一的，它被添加到一个空的东西中，这样就可以放在剪贴板中了。 在这种情况下，现在，通过 SetText 添加的第二次尝试也成功了。为什么它应该在这种情况下有点令人费解。

Sub Copying2()
Range("C1").Clear
Dim DtaObj As Object '
 Set DtaObj = GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
Let Range("A1").Value = "cellA1": Range("A1").Copy     '      This fills the Excel Clipboard, the Window Clipboard and the Office Clipboard
' DtaObj.PutInClipboard '
' MsgBox Prompt:="DtaObj.GetText(1) is   " & DtaObj.GetText()
 DtaObj.GetFromClipboard
 Let Application.CutCopyMode = False                        ' This clears the  Excel Clipboard
 Call ClearOffPainBouton                                    ' This clears the Office Clipboard
 MsgBox prompt:="DtaObj.GetText() is   " & DtaObj.GetText()
 DtaObj.SetText Text:="New Text"
 MsgBox prompt:="DtaObj.GetText() is   " & DtaObj.GetText()
' ActiveSheet.Paste Destination:=ActiveSheet.Range("C1")    ' This would error here
 DtaObj.PutInClipboard
 Let Application.CutCopyMode = False                        ' This clears the  Excel Clipboard
 Call ClearOffPainBouton                                    ' This clears the Office Clipboard
 ActiveSheet.Paste Destination:=ActiveSheet.Range("C1")
' New bit below - first 6 lines are not doing much if at all
 Range("C1").Clear
 DtaObj.PutInClipboard
 MsgBox prompt:="DtaObj.GetText() is   " & DtaObj.GetText()
 DtaObj.GetFromClipboard
 MsgBox prompt:="DtaObj.GetText() is   " & DtaObj.GetText()
 ActiveSheet.Paste Destination:=ActiveSheet.Range("C1")
' Below we manually copy
 MsgBox prompt:="Please copy anything from anywhere , before hitting  OK  "
 MsgBox prompt:="DtaObj.GetText() is   " & DtaObj.GetText() ' has not changed
 Range("C1").Clear
 ActiveSheet.Paste Destination:=ActiveSheet.Range("C1")     ' pastes what you copied
 DtaObj.GetFromClipboard
 MsgBox prompt:="DtaObj.GetText() is   " & DtaObj.GetText() ' now shows what you copied
' Attempt to use  SetText  to add to windows Clipboard
 DtaObj.SetText Text:="New Text To Paste"
 MsgBox prompt:="DtaObj.GetText() is   " & DtaObj.GetText() ' reflects the added text,  "New Text To Paste"
 DtaObj.PutInClipboard                                      ' This either does nothing or once again puts what you copied there - as it already is, then Excel may know you already did this so does nothing
 ActiveSheet.Paste Destination:=ActiveSheet.Range("C1")     ' pastes what you copied
 DtaObj.Clear
' MsgBox prompt:="DtaObj.GetText() is   " & DtaObj.GetText()' This would error - the registers are empty
' DtaObj.PutInClipboard ' This would also error - there is nothing in the registers to fill the clipboard with
' ActiveSheet.Paste Destination:=ActiveSheet.Range("C1")    ' pastes what you copied
 DtaObj.SetText Text:="New Text To Paste"
 MsgBox prompt:="DtaObj.GetText() is   " & DtaObj.GetText() ' reflects the added text,  "New Text To Paste"
 DtaObj.PutInClipboard
 ActiveSheet.Paste Destination:=ActiveSheet.Range("C1")     ' pastes "New Text To Paste"
 DtaObj.SetText Text:="second Text To Paste"
 MsgBox prompt:="DtaObj.GetText() is   " & DtaObj.GetText() ' reflects the added text,  "New Text To Paste"
 DtaObj.PutInClipboard
 ActiveSheet.Paste Destination:=ActiveSheet.Range("C1")     ' pastes "New Text To Paste"
End Sub

_.___________________________________________

回到最初的问题......解释奇怪的行为......只是我的看法......

_ …... 问：这种行为是预期的还是错误？

_ ....A

如果我对上述情况的评估是正确的，我想我会期望它：进行手动复制或通过编码进行复制，会在数据对象的寄存器中创建一个条目。这就是.GetText() 似乎得到的——最后输入的东西，无论是通过副本还是通过.SetText。 .SetText 不会对 .PutInClipboard 产生任何影响，除非寄存器为空。我想这样做的原因在某种程度上与您如何使用格式的东西来有效地拥有多文本有关。 清空这些寄存器需要什么总是不清楚的，也就是说，不清楚.Clear是否总是必要的。 显然，剪贴板对我认为的每个人来说仍然是个谜。

@蒂姆·威廉姆斯。

Sub Tester()

我认为您的Sub Tester() 的结果与我对这种情况的看法一致：如果您的 Windows 剪贴板中没有任何内容，您将需要您的代码行 d2.PutInClipboard 和 d.GetFromClipboard 来获取 d.GetText不是第一次出错。这将与在初始化寄存器方面执行d.SetText 具有类似的效果，这在某种程度上与d 相关。 （如果您在 Windows 剪贴板中有东西，那么您不需要 d2.PutInClipboard 来防止 d.GetText 出错，但它会返回您在 Windows 剪贴板中的内容。） 你永远不需要第二个和第三个d2.PutInClipboard，因为它们对你的编码没有任何影响：只要你有你的第一个d2.PutInClipboard，那么你就会得到你显示的结果。我的看法是.GetText 表示它知道的最后一件事是添加的。但是，您会发现，如果您将某些内容复制到 Windows 剪贴板并删除所有 3 个 d2.PutInClipboard 行，那么 d.GetText 将始终告诉您窗口剪贴板中的内容。在这种情况下，它不知何故失去了对d2 正在做什么的意识。要确认这一点，您可以尝试将某些内容复制到 Windows 剪贴板，然后运行 ​​Sub Testies3() ，其中删除了第一个 d2.PutInClipboard，但包括了第二个和第三个。在这种情况下，您的例程将一直告诉您 Windows 剪贴板中的内容，至少如果您从 Word 复制...。 ( ....如果您从 Excel 中复制某些内容...。那么当您第一次运行最后一个例程 Sub Testies3() 时，您会得到一些有趣的结果。有些东西正在设法使 d 知道 d2 正在做什么，从 Excel 复制某些内容后第一次运行代码。如果您从文本日期或浏览器中复制某些内容，也会发生这种情况，但如果您从 Word 复制则不会） 如果你试图完全理解剪贴板中相互依赖的意大利面条中发生了什么，那么你会发疯的……

Sub Tester()
Dim d As New DataObject, d2 As New DataObject
 d2.SetText "first": d2.PutInClipboard
 d.GetFromClipboard
 Debug.Print d.GetText  '--> "first"

 d2.SetText "second": 'd2.PutInClipboard
 Debug.Print d.GetText  '--> "second"

 d2.SetText "third" 'd2.PutInClipboard
 Debug.Print d.GetText  '--> "third"
End Sub
Sub Testes2() 'COPY SOMETING before running this
Dim d As New DataObject, d2 As New DataObject
 d2.SetText "first": 'd2.PutInClipboard
 d.GetFromClipboard
 Debug.Print d.GetText  '--> "What you copied"

 d2.SetText "second": 'd2.PutInClipboard
 Debug.Print d.GetText  '--> "What you copied"

 d2.SetText "third" 'd2.PutInClipboard
 Debug.Print d.GetText  '--> "What you copied"
End Sub
Sub Testies3() 'COPY SOMETING before running this
Dim d As New DataObject, d2 As New DataObject
 d2.SetText "first": 'd2.PutInClipboard
 d.GetFromClipboard
 Debug.Print d.GetText  '--> "What you copied"

 d2.SetText "second": d2.PutInClipboard
 Debug.Print d.GetText  '--> "What you copied"

 d2.SetText "third": d2.PutInClipboard
 Debug.Print d.GetText  '--> "What you copied"
End Sub