'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作者: lxh1968 时间: 2008-5-17 00:36
好好学习，天天向上。作者: 逛两脚 时间: 2009-3-27 17:31 标题: 好贴,顶顶更健康 好贴,顶顶更健康
