|
几年前,,写过一个关于Access附件字段的帖子:“从前有座山,山里有座庙……”——浅谈Access附件的上传与下载最近版友拿来用的时候发现了一些bug,于是QQ私信联系我。今天一看,原来是当时考虑不周所致,于是稍稍改了下原先的模块,代码如下:
- '***************************************************************************************************************
- '批量保存附件到文件
- '函数:SaveFileToAttachment(ByVal strTableName As String, ByVal strAttachFieldName As String)
- '
- '参数说明:
- '
- 'strTableName: 必选。字符串。表名称,用于打开记录集。理论上可以使用查询或者SQL语句,不过个人觉得使用表名称就好了。
- '
- 'strAttachFieldName: 必选。字符串。附件字段的名称,用于读取附件。
- '
- '
- '
- '使用方法:Call SaveFileToAttachment("表1","附件")
- '
- '
- '作者:Roych
- '
- '编写日期:2015-09-03
- '改进日期:2020-04-19
- '***************************************************************************************************************
- Function SaveFileToAttachment(ByVal strTableName As String, ByVal strAttachFieldName As String)
- '定义记录集
- Dim rst As DAO.Recordset
- '定义附件记录集
- Dim rstAtt As DAO.Recordset2
- '附件属性
- Dim FldAttData As DAO.Field2
- '定义文件拾取器和变量
- Dim fd As FileDialog
- Dim i As Long
- Dim J As Long
- Set rst = CurrentDb.OpenRecordset(strTableName)
- Set fd = Application.FileDialog(msoFileDialogFilePicker)
- With fd
- .AllowMultiSelect = True
- .Title = "请上传附件"
- .ButtonName = "浏览"
- If .Show = -1 Then
- rst.Edit
- For i = 1 To fd.SelectedItems.Count
- Set rstAtt = rst(strAttachFieldName).Value
- rstAtt.AddNew
- Set FldAttData = rstAtt.Fields("filedata")
- FldAttData.LoadFromFile fd.SelectedItems(i)
- rstAtt.Update
- rstAtt.Close
- Next
- rst.Update
- End If
- End With
- rst.Close
- Set rst = Nothing
- End Function
复制代码
当时考虑的是,一次性插入多条记录,每条记录插入多个附件的情况。然而实际工作中,这种应用场景也许不多。可能更多的情况是,每条记录插入若干个附件。“从前有座山,山上有座庙,庙里有个老和尚…”。嗯哼,他念歪了经。修改后的最终效果如下:
值得注意的是,Access中的追加查询是不允许插入多值字段的。所以在使用这个模块时,应当先追加其它字段,再更新附件字段。为了不至于更新出错,应当在第一个表上添加主键字段的条件。详细见附件,这里就不赘述了。
此外,考虑到很多版友可能会在实际工作中用上一些自定义编号模块,所以,把layaman_999同志的自定义编号模块引用过来(原贴见这里:高效的年月日的自动编号函数),在这里替广大网友一并谢过了!
最后奉上附件如下:
|
本帖子中包含更多资源
您需要 登录 才可以下载或查看,没有帐号?注册
x
|