' This is a sample code for extracting data from
' Access OLE Objects
' Author: Alex Ivanov
' Type Declarations and some parts of code borrowed from
' http://support.microsoft.com/default.aspx?scid=kb;EN-US;147727

Option Compare Database
Option Explicit

'Global Const LENGTH_FOR_SIZE = 4
'Global Const OBJECT_SIGNATURE = &H1C15
Global Const OBJECT_HEADER_SIZE = 20
'Global Const CHECKSUM_SIGNATURE = &HFE05AD00
'Global Const CHECKSUM_STRING_SIZE = 4

' PT : Window sizing information for object
'       used in OBJECTHEADER type.
Type PT
   Width As Integer
   Height As Integer
End Type

' OBJECTHEADER : Contains relevant information about object.
'
Type OBJECTHEADER
   Signature As Integer         ' Type signature (0x1c15).
   HeaderSize As Integer        ' Size of header (sizeof(struct
                                ' OBJECTHEADER) + cchName +
                                '  cchClass).
   ObjectType As Long           ' OLE Object type code (OT_STATIC,
                                '  OT_LINKED, OT_EMBEDDED).
   NameLen As Integer           ' Count of characters in object
                                '  name (CchSz(szName) + 1).
   ClassLen As Integer          ' Count of characters in class
                                '  name (CchSz(szClass) + 1).
   NameOffset As Integer        ' Offset of object name in
                                '  structure (sizeof(OBJECTHEADER)).
   ClassOffset As Integer       ' Offset of class name in
                                '  structure (ibName + cchName).
   ObjectSize As PT             ' Original size of object (see
                                '  code below for value).
   OleInfo As String * 256
End Type

Type OLEHEADER
   OleVersion As Long
   Format As Long
   TypeLen As Long
End Type

Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
        
 
Sub test()
Dim Buffer() As Byte
Dim BytesNeeded As Long

Dim ObjHeader As OBJECTHEADER
Dim sOleHeader() As Byte ' As String
Dim OleHdr As OLEHEADER

Dim r As DAO.Recordset
Dim className As String

' Get the blob
Set r = CurrentDb.OpenRecordset("select obRefID,obData from obRepository where obrefid =12")
' Get the Microsoft Access OBJECT header:
sOleHeader = r!obdata.GetChunk(0, OBJECT_HEADER_SIZE + 256) 'get some extra bytes for string data
CopyMemory ObjHeader, sOleHeader(0), OBJECT_HEADER_SIZE

Debug.Print "Signature: " & Hex(ObjHeader.Signature) & " HeaderSize: " & ObjHeader.HeaderSize
Debug.Print "ObjectType: " & ObjHeader.ObjectType & " NameLen: " & ObjHeader.NameLen & " ClassLen: " & ObjHeader.ClassLen
Debug.Print "NameOffset: " & ObjHeader.NameOffset & " ClassOffset: " & ObjHeader.ClassOffset
className = StrConv(MidB(sOleHeader, ObjHeader.ClassOffset + 1, ObjHeader.ClassLen - 1), vbUnicode)
'Get OLE Header
Buffer = r!obdata.GetChunk(ObjHeader.HeaderSize, 12)
CopyMemory OleHdr, Buffer(0), 12
'Get file length
Buffer = r!obdata.GetChunk(ObjHeader.HeaderSize + 20 + OleHdr.TypeLen, 12)
CopyMemory BytesNeeded, Buffer(0), 4

Debug.Print "OleVersion: " & OleHdr.OleVersion, " TypeLen: " & OleHdr.TypeLen, OleHdr.Format
Debug.Print "Name: '" & StrConv(MidB(sOleHeader, ObjHeader.NameOffset + 1, ObjHeader.NameLen - 1), vbUnicode) & "'"
Debug.Print "Class: '" & className & "'"
'Get the rest of the field and save it into a file
Buffer = r!obdata.GetChunk(ObjHeader.HeaderSize + 24 + OleHdr.TypeLen, BytesNeeded)
'select extension
Dim ext
If InStr(1, className, "Word.Document", vbTextCompare) > 0 Then
    ext = "doc"
ElseIf InStr(1, className, "Paint.Picture", vbTextCompare) > 0 Then
    ext = "bmp"
Else 'add more elseifs if needed
    ext = "tmp"
End If
Open "c:\test." & ext For Binary Access Write As #1
Put #1, , Buffer
Close #1

End Sub