Office中国论坛/Access中国论坛

标题: 【源码示例】“从前有座山，山里有座庙……”——浅谈Access附件的上传与下载 [打印本页]

作者: roych 时间: 2015-9-3 15:22
标题: 【源码示例】“从前有座山，山里有座庙……”——浅谈Access附件的上传与下载
本帖最后由 roych 于 2015-9-3 15:27 编辑

   前几天，群里的夏枯草问及如何保存附件中的文件。第一反应是ADO里的文件流（Stream）应该可以处理，马上推荐他去看红尘如烟关于上传下载的帖子。不过，似乎他没有找到解决办法。那好吧，我看看吧。嗯，我只看看，不说话，{:soso_e120:}——因为对附件字段不熟。
   于是，创建一个附件字段试试，发现有些意思：首先是单击附件字段，发现弹出一个类似于窗体的东西……这、这、这不就是加载项么？
[attach]57154[/attach]
   再设置一个查询，更有意思了：QBE界面是一个树结构。
[attach]57153[/attach]
   这么一来，我们就可以大胆假设：附件字段其实就是一个记录集。而每个附件则是一条由三个字段组成的记录，分别由FileData（估计是长二进制文件）保存数据，FileName（保存附件初始路径），FileType（保存附件的类型）。有了这三个属性，可以很方便地将文件与长二进制数据进行互转。
   这让我想起了很久以前听过的一个故事：
   “从前有座山,山里有座庙,庙里面有个老和尚在给小和尚讲故事,讲的故事是：
      从前有座山,山里有座庙,庙里面有个老和尚在给小和尚讲故事,讲的故事是：
      ……………………………………………………………………………………………………………”
   和故事不同的是，故事里不必分每座山、每座庙……的区别，但Access肯定是需要区分的，不然如何区别普通的记录集与RecordSet、Field等有所区别呢？果然发现多了RecordSet2、Field2【注意：这是2007版本以上的新属性】。然后再看看Filed2的方法。乖乖，SaveToFile、LoadFromFile……这不就是文件流（Stream）的两个重要方法吗？现在，我们大致可以肯定，这应该是封装给附件字段用的。
   接下来就简单多了，大体就是两个嵌套循环的编写过程。外层是普通记录集的的循环，逐条读取记录集的附件字段；内层自然是附件的文件流读写保存过程，还是老规矩，贴代码先（上传附件的代码不再贴，请自行下载附件）：

'*********************************************************************************************************************************
'批量保存附件到文件
'函数：SaveAttamentToFile(ByVal strSQL As String, ByVal strAttachFieldName As String)
'
'参数说明：
'
'strSQL：必选。字符串。表，查询或者SQL语句，用于打开记录集
'
'strAttachFieldName：必选。字符串。附件字段的名称，用于读取附件。
'
'使用方法：Call SaveAttamentToFile("表1","附件")
'
'作者：Roych
'
'编写日期：2015-09-03
'*********************************************************************************************************************************
Function SaveAttamentToFile(ByVal strSQL As String, ByVal strAttachFieldName As String)
'定义记录集
Dim rst As DAO.Recordset
'定义附件记录集
Dim rstAtt As DAO.Recordset2
'附件属性
Dim FldAttData As DAO.Field2
Dim FldAttPath As DAO.Field2
'定义文件夹拾取器
Dim fd As FileDialog
Set fd = Application.FileDialog(msoFileDialogFolderPicker)
Set rst = CurrentDb.OpenRecordset(strSQL)
With fd
.Title = "请选择保存的位置"
.ButtonName = "保存"
If .Show = -1 Then
Do Until rst.EOF
Set rstAtt = rst(strAttachFieldName).Value
Do Until rstAtt.EOF
Set FldAttData = rstAtt.Fields("filedata")
Set FldAttPath = rstAtt.Fields("filename")
'如果存在旧文件，则删除
If Len(Dir(fd.SelectedItems(1) & "" & FldAttPath)) > 0 Then Kill fd.SelectedItems(1) & "" & FldAttPath
'保存文件
FldAttData.SaveToFile fd.SelectedItems(1) & "" & FldAttPath
rstAtt.MoveNext
Loop
rstAtt.Close
rst.MoveNext
Loop
End If
End With
rst.Close
Set rstAtt = Nothing
Set rst = Nothing
End Function

复制代码

[attach]57155[/attach]

作者: 风中漫步 时间: 2015-9-3 16:16
谢谢分享

作者: admin 时间: 2015-9-3 22:22
这贴子强！加分了！

作者: xiaowuo2 时间: 2015-9-4 13:08
技术帝的贴，得顶！！！

作者: tmtony 时间: 2015-9-5 11:20
zpy2 回复的内容

Sub addAttachToImageStore()

  Dim dbs As DAO.Database
  Dim strSql As String
  Dim strTblName As String
  Dim strFieldName As String
  Dim rs As DAO.Recordset
  Dim rs2 As DAO.Recordset
  'Set dbs = CurrentDb
  'strTblName = "tblStudents"
  strTblName = "ImageStore"
  strSql = "select * from " & strTblName
  Set rs = CurrentDb.OpenRecordset(strSql)
  'rs.Edit
  rs.AddNew
  rs(0) = 10
  rs(1) = 1
  rs(2) = 5
  rs(3) = "c:\testpath\img1.gif"
  ' Add a new attachment.
  Set rs2 = rs.Fields("image_pic").Value
  rs2.AddNew
  rs2.Fields("FileData").LoadFromFile "c:\testpath\img1.gif" '"c:\ggg\altBackGrd.gif"
  rs2.Update
  rs2.Close

  rs.Update
  rs.Close
  Set rs2 = Nothing
  Set rs = Nothing
End Sub

作者: zpy2 时间: 2015-9-5 11:25
http://www.office-cn.net/forum.php?mod=viewthread&tid=120888&fromguid=hot&extra=&mobile=1&simpletype=no

作者: 522650696 时间: 2016-4-14 17:11

技术帝的贴，得顶！！！

作者: p51219 时间: 2016-7-10 00:24
好好好呵呵呵呵呵

作者: p51219 时间: 2016-7-10 00:24
好好好呵呵呵呵呵

作者: 初学者AA 时间: 2018-10-7 09:43
看不懂吖，小白白

欢迎光临 Office中国论坛/Access中国论坛 (http://www.office-cn.net/)

Powered by Discuz! X3.3