مساعدة في فصل الصور

[hamdy1111]

   السلام عليكم ، عندي قاعدة فيها بيانات الطلاب ناجح وراسب وصورهم ، ويوجد ارتباط لكل صورة لكل طالب محفوظه في مجلد خارج القاعدة  وأريد المساعدة في فصل صور الناجحين من المجلد الاصل إلى مجلد جديد ـ ولكم جزيل الشكر

فصل الصور.rar

[د.كاف يار]

31 دقائق مضت, hamdy1111 said:

   السلام عليكم ، عندي قاعدة فيها بيانات الطلاب ناجح وراسب وصورهم ، ويوجد ارتباط لكل صورة لكل طالب محفوظه في مجلد خارج القاعدة  وأريد المساعدة في فصل صور الناجحين من المجلد الاصل إلى مجلد جديد ـ ولكم جزيل الشكر

فصل الصور.rar 300.13 kB · 0 downloads

تفضل الكود و التعديل

On Error Resume Next
Dim MyFile, DstFile     As String
Dim Syso                As Object
Dim db                  As DAO.Database
Dim rs                  As DAO.Recordset

'====================================

Set rs = CurrentDb.OpenRecordset("SELECT * FROM Table1 where nategacode=2")
    rs.MoveFirst
    While (Not rs.EOF)
        MyFile = CurrentProject.Path & "\savefrom\" & Right$(rs.Fields("imagepath"), Len(rs.Fields("imagepath")) - InStrRev(rs.Fields("imagepath"), "\"))
        DstFile = CurrentProject.Path & "\saveto\" & Right$(rs.Fields("imagepath"), Len(rs.Fields("imagepath")) - InStrRev(rs.Fields("imagepath"), "\"))
        DBEngine.Idle
        Set Syso = CreateObject("Scripting.FileSystemObject")
        Syso.copyfile MyFile, DstFile
        Set Syso = Nothing
        Kill MyFile
        rs.Edit
        rs.Fields("imagepath").Value = DstFile
        rs.Update
        rs.MoveNext
    Wend
    rs.Close
Set rs = Nothing
MsgBox "تم نقل الصور بنجاح", vbInformation + vbMsgBoxRight, "تأكيد"
DoCmd.Requery

 

فصل صور الطلاب.zip

[hamdy1111]

 

سيدي ، عاجز عن الشكر جزاك الله خيرا ، اشتغل وزي الفل ، لكن يا ليت تكمل جميلك وتدلني على كيفية تعلم ما كتبته لأني لي 4 سنوات في الاكسس عمري ما قابلت اوامر بهذا الشكل  وجزاكم الله خيرا

[د.كاف يار]

الكود المستخدم هو التالي

On Error Resume Next
Dim MyFile, DstFile     As String
Dim Syso                As Object
Dim db                  As DAO.Database
Dim rs                  As DAO.Recordset

'====================================

' تحديد جدول البيانات
Set rs = CurrentDb.OpenRecordset("SELECT * FROM Table1 where nategacode=2")
    rs.MoveFirst
    While (Not rs.EOF)

		' استخراج اسم الملف من رابط الصورة داخل قاعدة البيانات
        MyFile = CurrentProject.Path & "\savefrom\" & Right$(rs.Fields("imagepath"), Len(rs.Fields("imagepath")) - InStrRev(rs.Fields("imagepath"), "\"))

		' تحديد مسار المجدل الثاني و اضافة اسم الصورة المستخرج من الكود اعلاه
        DstFile = CurrentProject.Path & "\saveto\" & Right$(rs.Fields("imagepath"), Len(rs.Fields("imagepath")) - InStrRev(rs.Fields("imagepath"), "\"))
        
		'البدء في انشاء نسخة مماثلة من الملف المحدد اعلاه
		DBEngine.Idle
        Set Syso = CreateObject("Scripting.FileSystemObject")

		' مسار الملف الأصلي و المسار الجديد
        Syso.copyfile MyFile, DstFile
        Set Syso = Nothing
		
		'حذف الملف من المجلد الرئيسي بعد نسخه 
        Kill MyFile

		'تعديل المسار داخل الجدول
        rs.Edit
        rs.Fields("imagepath").Value = DstFile
        rs.Update
        rs.MoveNext
    Wend
    rs.Close
Set rs = Nothing

 

 

[د.كاف يار]

نقسم الكود لكي يسهل الشرح

بهذا الكود تستطيع انشاء نسخة مماثلة لأي ملف مهما كان الامتداد

Dim MyFile, DstFile As String
Dim Syso As Object

MyFile = File_Name      ' Old File
DstFile = CurrentProject.Path & "\Folder_Name\" & " New_File_Name"    ' New File

DBEngine.Idle

Set Syso = CreateObject("Scripting.FileSystemObject")
Syso.copyfile MyFile, DstFile
Set Syso = Nothing

 

لحذف اي ملف 

Kill " C:\\ File Path ....."

 

[hamdy1111]

 بارك الله فيك اخي د كاف وكنت ارجو ان تحيلني لرابط فيه كافة اوامر اكسس مع الشرح

 

[د.كاف يار]

14 ساعات مضت, hamdy1111 said:

 بارك الله فيك اخي د كاف وكنت ارجو ان تحيلني لرابط فيه كافة اوامر اكسس مع الشرح

 

تفضل هذا الموقع اجعله مرجع لك ستجد كل ما تحتاجه من اكواد 

microsoft

[abouelhassan]

18 ساعات مضت, د.كاف يار said:

تفضل هذا الموقع اجعله مرجع لك ستجد كل ما تحتاجه من اكواد 

microsoft

زادك الله من فضله استاذ الحبيب ربنا يحفظك يارب ويديك الصحة والعافية

شكر وتقدير واحترام من اخيك

[hamdy1111]

بارك الله في الجميع وفي د كاف يار وجزاكم الله خيرا