الربط التلقائي للجداول الموجودة في المجلد

هذا كود الرط............حاول الاستفادة منه...............أو أرفق مثالا بنتشيق 2003 للتعديل عليه

  Private Function Relink(tblPath As String, progPath As String, Optional blnSilent As Boolean = True) As Boolean
    Dim db As DAO.Database   '       كودالربط
    Dim tdf As DAO.TableDef
        Dim acbRelink

    On Error GoTo HandleErrors
    
    ' Validate path
    If Not IsExist(tblPath) Then
        If Not blnSilent Then
            acbRelink = False
            MsgBox "لم يتم العثور على قاعدة البيانات فى مجلد البرنامج "
            GoTo ExitHere
        End If
    End If
    
    Call SysCmd(acSysCmdSetStatus, "Re-linking the data tables...")
    Set db = DBEngine.Workspaces(0).OpenDatabase(progPath)  'CurrentDb()
    For Each tdf In db.TableDefs
        If (tdf.Attributes And dbAttachedTable) = _
         dbAttachedTable Then
            tdf.Connect = ";DATABASE=" & tblPath
            tdf.RefreshLink
        End If
    Next
    Call SysCmd(acSysCmdClearStatus)
    
    ' Success!
    If Not blnSilent Then
        MsgBox "تم إعادة ربط البيانات.", vbInformation
    End If

    acbRelink = True
        db.Close
        Set db = Nothing

ExitHere:
    Call SysCmd(acSysCmdClearStatus)
    Exit Function
    
HandleErrors:
    acbRelink = False
    Select Case Err.Number
     Case 3011
            MsgBox "لم يتم العثور على أحد الجداول فى قاعدة البيانات " + Chr(10) + Chr(13) + " يجب تحديد النسخة المحقوظة ثم اعادة تشغيل البرنامج ", , "قاعدة البيانات غير مكتملة"
        Case Else
            If Not blnSilent Then
                MsgBox Err.Description, , "acbRelink Error " & Err.Number
            End If
    End Select
    Resume ExitHere
End Function

أخي ( أواب ) جعلني الله وإياك من " الأوابين " :

تفضل المثال مرفق .

Data_Base.rar

تفضل أخي الكريم

لا تنسى التقييم

++Data_Base.rar

ممتاز ..
ماشاء الله تبارك الله .

الله ينفع بك ويزيدك من علمه ويبارك فيك وفي علمك .

10/10

ممكن لو أردنا عزل أوامر حذف الجداول السابقة ( فقط للفائدة ) ماهو التعديل الواجب على الكود .