MS Access：如何将给定名称的附件（图像）导出到文件夹？ [英] MS Access: How to export attachments (images) with a given name to a folder?
问题描述
所以，我必须修改它，我的想法不是将图片包含在数据库附件中，我只是将路径和图片的名称作为字符串存储在列中，然后在需要时调用它，我已经设法完成了！
现在，什么我要做的是，找到一种方法，将所有现有图像（大约3000张图片）从数据库中重新命名（将其描述存储在数据库中的另一列中）导出到文件夹中，因为它们的名称类似于IMG_＃ ###，我不想在导出之后手动找到并重命名它们）
如果我成功，数据库大小将显着降低，性能提高，这是一个梦想！
可以你可以指导我怎么做？
我在互联网上找到了一些东西，但它只是导出第一个记录集的附件，我如何修改这是我的需要吗？
D im strPath As String
Dim rs As DAO.Recordset
Dim rsPictures As Variant
strPath = Application.CurrentProject.Path
'????如何循环所有记录集???
'实例化父记录集。
设置rs = CurrentDb.OpenRecordset（资产）
'实例化子记录集。
设置rsPictures = rs.Fields（附件）。值
'循环附件。
虽然不是rsPictures.EOF
'????如何重命名图片???
'将当前附件保存到我的文档文件夹中的磁盘。
rsPictures.Fields（FileData）。SaveToFile strPath& \Attachment
rsPictures.MoveNext
Wend
提前谢谢。我非常感谢你的帮助！
经过两天的挖掘，我可以弄清楚我想要的。
现在，我可以将数据库中的所有附件导出到给定的文件夹，将图片的路径和名称插入到数据库中，并将数据库的大小从2GB调整为8MB！ YESSS！
请问，如果你有问题。
这是代码：
sub exportAttachments（）
Dim strPath， fName，fldName，sName（3）As String
Dim rsPictures，rsDes As Variant
Dim rs As DAO.Recordset
Dim savedFile，i As Integer
savedFile = 0
strPath = Application.CurrentProject.Path
设置rs = CurrentDb.OpenRecordset（SELECT * FROM Employees）
'查看实际记录集包含行
如果没有（rs.EOF和rs.BOF）然后
rs.MoveFirst'不需要这里，但仍然是一个好习惯
做直到rs.EOF = True
On Error Resume Next'忽略错误
'实例化子记录集。
设置rsPictures = rs.Fields（附件）值
设置rsDes = rs.Fields（Name）'用于稍后命名图像
'如果没有附件可用，转到下一条记录
如果Len（rsPictures.Fields（FileName））= 0然后
GoTo nextRS
End If
如果rsPictures.RecordCount<> 0然后
rsPictures.MoveLast
savedFile = rsPictures.RecordCount'set savedFile =附加的总数
结束如果
rsPictures.MoveFirst'移动到第一个附件文件
'警告：我的所有附件都是带有JPG扩展名的图片。
'循环遍历所有附件
对于i = 1要保存文件'重命名所有文件并保存
如果不是rsPictures.EOF然后
fName = strPath& \Attachments\& rsDes&我& .JPG
rsPictures.Fields（FileData）。SaveToFile fName
sName（i）= fName'保留数组中的路径以供以后使用
rsPictures.MoveNext
结束如果
Next i
'将图像名称和路径插入数据库，编辑
rs.Edit
如果Len（sName（1））< > 0然后
rs！PicPath1 = CStr（sName（1））'path
rs！PicDes1 = Left（Dir（sName（1）），InStr（1，Dir（sName（1） 。） - 1）'没有扩展名的文件名
End If
如果Len（sName（2））<> 0然后
rs！PicPath2 = CStr（sName（2））
rs！PicDes2 = Left（Dir（sName（2）），InStr（1，Dir（sName（2））， ） - 1）
End If
如果Len（sName（3））<> 0然后
rs！PicPath3 = CStr（sName（3））
rs！PicDes3 = Left（Dir（sName（3）），InStr（1，Dir（sName（3））， ） - 1）
如果
rs.Update'更新记录
nextRS：
rsPictures.Close'close attachment
savedFile = 0' next
fName = 0'reset
'移至下一个记录。
rs.MoveNext
循环
Else
MsgBox记录集中没有记录。
结束如果
MsgBox附件已导出！
rs.Close'关闭db记录
设置rs =无清理
结束子
My ex-colleague built an access database with many record sets and each of them has one to five pictures attached. The size of the database is now really big (about 2 GB) and it is really slow. The bad news is, more data are coming in each day:(
So, I have to modify it. My idea is instead of including the pictures in the database attachment, I just store the path and the name of the picture as strings in the columns and then recall them whenever I need. I've managed to do that!
Now, what I have to do, is finding a way to export all of the existing images (about 3000 pictures) from the database to a folder after renaming them (with their description stored in another column in the DB, because now their names are like IMG_####, and I don't want to find AND rename them manually after exporting). If I succeeded, the DB size would significantly be reduced and its performance improved. And it's a dream! Could you please guide me how to do this?
I've found something on the internet. But it just export the attachment of the first record set only. How could I modify this to my need?
Dim strPath As String
Dim rs As DAO.Recordset
Dim rsPictures As Variant
strPath = Application.CurrentProject.Path
'????How to loop through all record set???
' Instantiate the parent recordset.
Set rs = CurrentDb.OpenRecordset("Assets")
' Instantiate the child recordset.
Set rsPictures = rs.Fields("Attachments").Value
' Loop through the attachments.
While Not rsPictures.EOF
'????How to rename the picture???
' Save current attachment to disk in the "My Documents" folder.
rsPictures.Fields("FileData").SaveToFile strPath & "\Attachment"
rsPictures.MoveNext
Wend
Thank you in advance. I really appreciate your help!
after two days digging, I could figure out what I wanted. Now, I can export all the attachments from the database to a given folder, insert the path and name of the picture into the database and resize my database from 2GB to 8MB! YESSS!
Please ask,if you had questions. Here is the code for that:
sub exportAttachments()
Dim strPath, fName, fldName, sName(3) As String
Dim rsPictures, rsDes As Variant
Dim rs As DAO.Recordset
Dim savedFile, i As Integer
savedFile = 0
strPath = Application.CurrentProject.Path
Set rs = CurrentDb.OpenRecordset("SELECT * FROM Employees")
'Check to see if the recordset actually contains rows
If Not (rs.EOF And rs.BOF) Then
rs.MoveFirst 'Not required here, but still a good habit
Do Until rs.EOF = True
On Error Resume Next 'ignore errors
'Instantiate the child record set.
Set rsPictures = rs.Fields("Attachments").Value
Set rsDes = rs.Fields("Name") 'use to name the picture later
'if no attachment available, go to next record
If Len(rsPictures.Fields("FileName")) = 0 Then
GoTo nextRS
End If
If rsPictures.RecordCount <> 0 Then
rsPictures.MoveLast
savedFile = rsPictures.RecordCount 'set savedFile = total no of attachments
End If
rsPictures.MoveFirst ' move to first attachment file
'WARNING: all of my attachments are picture with JPG extension.
'loop through all attachments
For i = 1 To savedFile 'rename all files and save
If Not rsPictures.EOF Then
fName = strPath & "\Attachments\" & rsDes & i & ".JPG"
rsPictures.Fields("FileData").SaveToFile fName
sName(i) = fName 'keep path in an array for later use
rsPictures.MoveNext
End If
Next i
'insert image name and path into database an edit
rs.Edit
If Len(sName(1)) <> 0 Then
rs!PicPath1 = CStr(sName(1)) 'path
rs!PicDes1 = Left(Dir(sName(1)), InStr(1, Dir(sName(1)), ".") - 1) 'file name without extension
End If
If Len(sName(2)) <> 0 Then
rs!PicPath2 = CStr(sName(2))
rs!PicDes2 = Left(Dir(sName(2)), InStr(1, Dir(sName(2)), ".") - 1)
End If
If Len(sName(3)) <> 0 Then
rs!PicPath3 = CStr(sName(3))
rs!PicDes3 = Left(Dir(sName(3)), InStr(1, Dir(sName(3)), ".") - 1)
End If
rs.Update 'update record
nextRS:
rsPictures.Close 'close attachment
savedFile = 0 'reset for next
fName = 0 'reset
'Move to the next record.
rs.MoveNext
Loop
Else
MsgBox "There are no records in the recordset."
End If
MsgBox "Attachments were exported!"
rs.Close 'Close the db recordsets
Set rs = Nothing 'Clean up
End Sub
这篇关于MS Access：如何将给定名称的附件（图像）导出到文件夹？的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！
