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