如何读取嵌入的单词对象的二进制内容

时间:2018-01-26 17:44:24

标签: vba ms-word ole

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

1 个答案:

答案 0 :(得分:0)

以下代码实现了我想要的目标:

' 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