如何读取嵌入字对象的二进制内容答案

【问题标题】：How to read binary content of an embeded word object如何读取嵌入字对象的二进制内容
【发布时间】：2018-01-26 17:44:24
【问题描述】：

我有一个嵌入的 OLE 对象作为“InlineShape”。我想将此对象作为数据流/字符串访问。目前，我可以通过 OLEObject 看到一些关于 Excel 的想法，但我似乎没有看到 Word 的解决方案。

【问题讨论】：

把它放在剪贴板上并从那里访问它；复制/粘贴到可以操纵它的地方；读出 Word Open XML 并从其中的 base64 表示中工作；将其作为图片保存到文件中并使用该文件...
@Cindy InlineShape.OLEFormat 不幸的是没有复制方法。图片位可能会起作用。
啊，但是InlineShape.Range 确实有一个Copy方法并且会复制图片。
@CindyMeister 谢谢，我设法按照以下方法编造了一些东西

标签： vba ms-word ole

【解决方案1】：

下面的代码实现了我想要的：

' from here: https://stackoverflow.com/questions/1356118/vba-ws-toolkit-how-to-get-current-file-as-byte-array
Public Function GetFileBytes(ByVal path As String) As Byte()
    Dim lngFileNum As Long
    Dim bytRtnVal() As Byte
    lngFileNum = FreeFile
    If LenB(Dir(path)) Then ''// Does file exist?
        Open path For Binary Access Read As lngFileNum
        ReDim bytRtnVal(LOF(lngFileNum) - 1&) As Byte
        Get lngFileNum, , bytRtnVal
        Close lngFileNum
    Else
        Err.Raise 53
    End If
    GetFileBytes = bytRtnVal
    Erase bytRtnVal
End Function



Sub TestMe()
    Dim shapeIndex As Integer: shapeIndex = 1
    Dim ns As Object
    Dim folderItem
    Const namePrefix = "site-visit-v2.5"
    Const nameSuffix = ".dat"

    Dim fileBytes() As Byte
    Dim tempDir As String: tempDir = Environ("TEMP")
    ' first embedded Item - you may need adjust if you have more shapes
    ActiveDocument.InlineShapes.Item(shapeIndex).Range.Copy

    ' paste it to temp dir
    Set ns = CreateObject("Shell.Application").namespace((tempDir))
    ns.Self.InvokeVerb ("Paste")

    ' find the file now
    Dim Item As Object
    Dim rightItem As Object
    Set rightItem = Nothing
    ' find the file that was pasted
    ' because when files are pasted and name exists, you could get a name such as "site-visit-v2.5 (10).dat"
    ' we pick the most recent that matches
    For Each Item In ns.Items
        If Item.Name Like namePrefix & "*" & nameSuffix Then
            If rightItem Is Nothing Then
                Set rightItem = Item
            Else
                If Item.modifyDate > rightItem.modifyDate Then 'a more recent date is found
                Set rightItem = Item
                End If
            End If
        End If
    Next
    fileBytes = GetFileBytes(tempDir & "\" & rightItem.Name)
    MsgBox "Read " & UBound(fileBytes) + 1 & " bytes"
End Sub

【讨论】：