【源码示例】“从前有座山，山里有座庙……”——浅谈Access附件的上传与下载

roych

       前几天，群里的夏枯草问及如何保存附件中的文件。第一反应是ADO里的文件流（Stream）应该可以处理，马上推荐他去看红尘如烟关于上传下载的帖子。不过，似乎他没有找到解决办法。那好吧，我看看吧。嗯，我只看看，不说话，{:soso_e120:}——因为对附件字段不熟。
      于是，创建一个附件字段试试，发现有些意思：首先是单击附件字段，发现弹出一个类似于窗体的东西……这、这、这不就是加载项么？

       再设置一个查询，更有意思了：QBE界面是一个树结构。

       这么一来，我们就可以大胆假设：附件字段其实就是一个记录集。而每个附件则是一条由三个字段组成的记录，分别由FileData（估计是长二进制文件）保存数据，FileName（保存附件初始路径），FileType（保存附件的类型）。有了这三个属性，可以很方便地将文件与长二进制数据进行互转。
       这让我想起了很久以前听过的一个故事：
       “从前有座山,山里有座庙,庙里面有个老和尚在给小和尚讲故事,讲的故事是：
        从前有座山,山里有座庙,庙里面有个老和尚在给小和尚讲故事,讲的故事是：
        ……………………………………………………………………………………………………………”
       和故事不同的是，故事里不必分每座山、每座庙……的区别，但Access肯定是需要区分的，不然如何区别普通的记录集与RecordSet、Field等有所区别呢？果然发现多了RecordSet2、Field2【注意：这是2007版本以上的新属性】。然后再看看Filed2的方法。乖乖，SaveToFile、LoadFromFile……这不就是文件流（Stream）的两个重要方法吗？现在，我们大致可以肯定，这应该是封装给附件字段用的。
       接下来就简单多了，大体就是两个嵌套循环的编写过程。外层是普通记录集的的循环，逐条读取记录集的附件字段；内层自然是附件的文件流读写保存过程，还是老规矩，贴代码先（上传附件的代码不再贴，请自行下载附件）：

1. '*********************************************************************************************************************************
   
2. '批量保存附件到文件
   
3. '函数：SaveAttamentToFile(ByVal strSQL As String, ByVal strAttachFieldName As String)
   
4. '
   
5. '参数说明：
   
6. '
   
7. 'strSQL：                   必选。字符串。表，查询或者SQL语句，用于打开记录集
   
8. '
   
9. 'strAttachFieldName：       必选。字符串。附件字段的名称，用于读取附件。
   
10. '
    
11. '使用方法：Call SaveAttamentToFile("表1","附件")
    
12. '
    
13. '作者：Roych
    
14. '
    
15. '编写日期：2015-09-03
    
16. '*********************************************************************************************************************************
    
17. 
    
18. Function SaveAttamentToFile(ByVal strSQL As String, ByVal strAttachFieldName As String)
    
19. '定义记录集
    
20. Dim rst As DAO.Recordset
    
21. '定义附件记录集
    
22. Dim rstAtt As DAO.Recordset2
    
23. '附件属性
    
24. Dim FldAttData As DAO.Field2
    
25. Dim FldAttPath As DAO.Field2
    
26. '定义文件夹拾取器
    
27. Dim fd As FileDialog
    
28. Set fd = Application.FileDialog(msoFileDialogFolderPicker)
    
29. 
    
30. Set rst = CurrentDb.OpenRecordset(strSQL)
    
31. With fd
    
32.     .Title = "请选择保存的位置"
    
33.     .ButtonName = "保存"
    
34.     If .Show = -1 Then
    
35.         Do Until rst.EOF
    
36.             Set rstAtt = rst(strAttachFieldName).Value
    
37.             Do Until rstAtt.EOF
    
38.                 Set FldAttData = rstAtt.Fields("filedata")
    
39.                 Set FldAttPath = rstAtt.Fields("filename")
    
40.                 '如果存在旧文件，则删除
    
41.                 If Len(Dir(fd.SelectedItems(1) & "" & FldAttPath)) > 0 Then Kill fd.SelectedItems(1) & "" & FldAttPath
    
42.                 '保存文件
    
43.                 FldAttData.SaveToFile fd.SelectedItems(1) & "" & FldAttPath
    
44.                 rstAtt.MoveNext
    
45.             Loop
    
46.             rstAtt.Close
    
47.             rst.MoveNext
    
48.         Loop
    
49.     End If
    
50. End With
    
51. rst.Close
    
52. Set rstAtt = Nothing
    
53. Set rst = Nothing
    
54. End Function

复制代码

风中漫步

谢谢分享

admin

这贴子强！加分了！

xiaowuo2

技术帝的贴，得顶！！！

tmtony

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

http://www.office-cn.net/forum.php?mod=viewthread&tid=120888&fromguid=hot&extra=&mobile=1&simpletype=no

522650696

技术帝的贴，得顶！！！

p51219

好好好呵呵呵呵呵

p51219

好好好呵呵呵呵呵

初学者AA

看不懂吖，小白白