ممكن شرح مفصل لهذا الكود

[sandanet]

السلام عليكم ورحمة الله تعالى وبركاته

 

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

 

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

 

وظيفة الكود هي مقارنة اسماء الملفات الموجودة في في المسار Me.pate مع الملفات الموجودة في النوذج الفرعي Me.Table2 في الحقل ImagePath حيث ان الملفات تخزن في هذا الحقل بكامل مسارها بالشكل التالي C:\Users\mypc\Desktop\All_Files\123\2017-05-27_18.28.43_66.jpg

 

ارجو من الاخوة الكرام التفضل بتفصيل خطوات عمل الكود للأهمية ولكم مني جزيل الشكر

 

تحياتي

 

 

Function Make_File_Array()
On Error GoTo err_Make_File_Array

'Folder info

    Dim File_Count As Integer
    Dim fdr As Variant
    Dim Files_Array() As Variant
    
        
    'No Path, exit
    If Len(Me.pate & "") = 0 Then Exit Function
    
    'get the file count from the Forlder, and
    'place the files in an array
    fdr = Dir(Me.pate & "\" & "*.*")
    File_Count = 0
    Do While fdr <> ""
        File_Count = File_Count + 1
        
        ReDim Preserve Files_Array(File_Count)
        Files_Array(File_Count) = fdr
        
        fdr = Dir
        
    Loop
    

    
'got the folder file count=File_Count, and the files=Files_Array(i)
'SubForm Records

    Dim rst As DAO.Recordset
    
    Set rst = Me.Table2.Form.RecordsetClone
    rst.MoveLast: rst.MoveFirst
    rc = rst.RecordCount
    
    
    
  '1. Make all Records, File_Check=2 (No File)
    For j = 1 To rc
        rst.Edit
            rst!File_Check = 2
        rst.Update
    
        rst.MoveNext
    Next j


'======================
  '2. Compare
    For i = 1 To UBound(Files_Array)    'File_Count
  
        iname_morfke = "\" & Files_Array(i)
        
        'itayp = Mid(Files_Array(i), InStrRev(Files_Array(i), ".") + 1)
            
         rst.FindFirst "ImagePath='" & Me.pate & iname_morfke & "'"
                
            If rst.NoMatch Then
                'No Match
                rst.Edit
                     rst!File_Check = 2
                 rst.Update

                Else
                rst.Edit
                    rst!File_Check = 1
                rst.Update
                End If
            
        
    Next i

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

    rst.Requery
    
    rst.close: Set rst = Nothing

   

Exit Function

 

تم تعديل سبتمبر 2, 2017 بواسطه sandanet