السلام عليكم ورحمة الله وبركاته ..
تحية طيبة إخواني .. 🌹
أحضرت لكم اليوم كود وظيفته استخراج الملفات المخزنة في جداول الأكسس كمرفقات داخلية إلى خارج قاعدة البيانات دفعة واحدة 🙂
وهو مفيد جدا لمن لديه قاعدة بيانات قد ملئها بالمرفقات ويحاول الآن تصغير القاعدة باستخراج المرفقات منها وحفظها خارج قاعدة البيانات بسهولة ويسر .. بدل حفظها ملف ملف وهي عملية مرهقة بالتأكيد .. خصوصا إذا كان عدد المرفقات بالمئات ..
إليكم الكود :
Public Function ExtractAllAttachments(ByVal TableName As String, ByVal AttchmentColumnName As String, ByVal ExtractToFolder As String)
' TableName : اسم الجدول
' AttchmentColumnName : اسم حقل المرفقات
' ExtractToFolder: المكان المراد استخراج الملفات إليه مثال : "C:\ExtractHere"
Dim RsMainrecords As dao.Recordset2
Dim RsAttachments As dao.Recordset2
Set RsMainrecords = CurrentDb.OpenRecordset("select " & AttchmentColumnName & _
" from " & TableName & _
" where " & AttchmentColumnName & ".FileName is not Null")
Do Until RsMainrecords.EOF
Set RsAttachments = RsMainrecords.Fields(AttchmentColumnName).Value
Do Until RsAttachments.EOF
Dim OutputFileName As String
OutputFileName = RsAttachments.Fields("FileName").Value
OutputFileName = ExtractToFolder & "\" & OutputFileName
RsAttachments.Fields("FileData").SaveToFile OutputFileName
RsAttachments.MoveNext
Loop
RsAttachments.Close
RsMainrecords.MoveNext
Loop
RsMainrecords.Close
Set RsMainrecords = Nothing
Set RsAttachments = Nothing
End Function
ويتم تشغيله بالطريقة التالية :
ExtractAllAttachments("TableName","AttchmentColumnName","ExtractToFolder")
ستحتاج لإعطائه 1- اسم الجدول ، 2 - اسم الحقل ، 3 - المكان الذي تريد استخراج المرفقات فيه .
المصدر :
https://www.youtube.com/watch?v=jHIgay9goWo