MS <B >Access <B >OLE <B >Object to Disk <B >File Export
--------------------------------------------------------------------------------
'Written : 9 Jun 2004
'Modified : 27 Jul 2004
'Author : Sonam Gurung 2004
'Module to export bmp <B >file data from <B >OLE Field to disk <B >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 <B >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
[此贴子已经被作者于2004-8-26 13:15:00编辑过]
|