设为首页收藏本站Access中国

Office中国论坛/Access中国论坛

 找回密码
 注册

QQ登录

只需一步,快速开始

12下一页
返回列表 发新帖
查看: 12783|回复: 15
打印 上一主题 下一主题

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

[复制链接]

点击这里给我发消息

跳转到指定楼层
1#
发表于 2004-6-24 05:42:00 | 只看该作者 回帖奖励 |倒序浏览 |阅读模式
通过VBA编程使用DAO或ADO方式将文件写入表OLE字段

与 直接在OLE字段中按右键菜单->插入对象 选择文件插入

这两种方式实际上是不相同的.

1.使用VBA编程插入的文件,在OLE字段上双击不会打开相应的容器程序

2.使用插入对象方法插入的文件,无法直接通过DAO或ADO方法读出,因为插入的文件有OLE头文件,而不仅是插入的文件的内容

我们知道,使用VBA编程写入OLE字段的文件或对象可以再使用VBA代码还原成一个文件,那如何实现将用"插入对象"方式插入OLE字段的对象,通过VBA代码汇出到一个文件,汇出的文件扩展名需与插入前的扩展名一样,而且汇出的文件格式完整,能够正常打开.
分享到:  QQ好友和群QQ好友和群 QQ空间QQ空间 腾讯微博腾讯微博 腾讯朋友腾讯朋友
收藏收藏1 分享分享 分享淘帖 订阅订阅
2#
发表于 2004-6-25 21:20:00 | 只看该作者
BMP文件可以,有人做过,其它不知行

点击这里给我发消息

3#
发表于 2004-6-26 19:34:00 | 只看该作者
这个题值得做,做出来比较有意义

点击这里给我发消息

4#
发表于 2004-7-1 08:16:00 | 只看该作者
记得以前effiel 和cg1和我都有关相关的探讨,但都未完全解决这道难题。我现在只能实现excel word bmp一些已知扩展名的文件导出。对未知文件扩展名的则未找到适当的方法。

5#
发表于 2004-8-26 05:18:00 | 只看该作者
我用asp显示过ole字段中的word文件,方法是查找word文件开头的特征字,把之前的砍掉,但总感觉是凑出来的。我想ole文件头应该有一些格式,有谁能找到格式说明就行,例如偏移字段在哪等。
6#
发表于 2004-8-26 17:28:00 | 只看该作者
可能xls、doc、bmp等格式各有不同!
7#
发表于 2004-8-26 21:12:00 | 只看该作者
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编辑过]

点击这里给我发消息

8#
发表于 2008-4-23 18:36:57 | 只看该作者
整理一下,未测试

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
9#
发表于 2008-5-17 00:36:59 | 只看该作者
好好学习,天天向上。
10#
发表于 2009-3-27 17:31:13 | 只看该作者

好贴,顶顶更健康

好贴,顶顶更健康
















古之立大事者,不惟有超世之才,亦必有坚忍不拔之志。---魔兽剑圣异界纵横
极品家丁 龙蛇演义 恶魔法则 斗罗大陆 异界枪神 凡人修仙传 魔兽领主 超级农民 极品公子 飞升之后
您需要登录后才可以回帖 登录 | 注册

本版积分规则

QQ|站长邮箱|小黑屋|手机版|Office中国/Access中国 ( 粤ICP备10043721号-1 )  

GMT+8, 2024-4-25 12:34 , Processed in 0.115191 second(s), 33 queries .

Powered by Discuz! X3.3

© 2001-2017 Comsenz Inc.

快速回复 返回顶部 返回列表