[A高7]如何使用VBA代码将插入OLE字段中的对象还原成一个文件

zhuyiwen

整理一下，未测试

MS Access OLE Object to Disk File Export

--------------------------------------------------------------------------------

'Written : 9 Jun 2004
'Modified : 27 Jul 2004
'Author : Sonam Gurung 2004
'Module to export bmp file data from OLE Field to disk file
'===========================

Option Compare Database
Option Explicit

'Constants That User Can Modify
Const table = "table1"
Const unid = "id"
Const field = "data"
Const dirpath = "c:\"
'End of Constant Declaration

Sub SaveOLEToFile()
        Dim db As Database, rs As DAO.Recordset, q As String, fname As String, b() As Byte
        Set db = CurrentDb()
        q = "select " & unid & "," & field & " from " & table
        Set rs = db.OpenRecordset(q)
        While Not rs.EOF
                fname = dirpath & "\" & Trim(Str(rs.Fields(0).Value)) & ".tif"
                ReDim b(rs.Fields(1).Size)
                b = rs.Fields(1).Value
                Open fname For Binary Access Write As #1
                Put #1, , b
                Close #1
                TrimFile (fname)
                rs.MoveNext
        Wend
        rs.Close
        Set rs = Nothing
End Sub

Sub TrimFile(ByVal fname As String)
        Dim b() As Byte, l As Long
        ReDim b(4)
        Open fname For Binary As #1
        For l = 1 To LOF(1)
                Seek #1, l
                Get #1, , b
                If b(0) = asc("B") And b(1) = asc("M") And b(2) = asc("B") and b(3)="K" Then Seek #1, l: Exit For
        Next l
        ReDim b(LOF(1) - l)
        Get #1, , b
        Close #1

        Open fname For Binary As #1
        Put #1, , b
        Close #1
End Sub