تصدير كائن

[بسام محرز]

الأخوة الأعزاء ... أريد كود تصدير كائن من أكسس إلى أكسس مع إمكانية استبدال الكائن القديم بالجديد مباشرة دون السؤال ....  و لكم جزيل الشكر

[ابو جودي]

يعنى ايه ممكن توضيح اكتر

[ابو جودي]

على العموم هذا موديول يقوم بعمل تصدير لكل شئ من قاعدة الى اخرى يمكنك تعديل ما تريد حسب احتياجاتك

Public Sub ExpObj2ExtDb(sExtDb As String)
    On Error GoTo Error_Handler
    Dim qdf             As QueryDef
    Dim tdf             As TableDef
    Dim obj             As AccessObject
 
    ' Forms.
    For Each obj In CurrentProject.AllForms
        DoCmd.TransferDatabase acExport, "Microsoft Access", sExtDb, _
                               acForm, obj.Name, obj.Name, False
    Next obj
 
    ' Macros.
    For Each obj In CurrentProject.AllMacros
        DoCmd.TransferDatabase acExport, "Microsoft Access", sExtDb, _
                               acMacro, obj.Name, obj.Name, False
    Next obj
 
    ' Modules.
    For Each obj In CurrentProject.AllModules
        DoCmd.TransferDatabase acExport, "Microsoft Access", sExtDb, _
                               acModule, obj.Name, obj.Name, False
    Next obj
 
    ' Queries.
    For Each qdf In CurrentDb.QueryDefs
        If Left(qdf.Name, 1) <> "~" Then    'Ignore/Skip system generated queries
            DoCmd.TransferDatabase acExport, "Microsoft Access", sExtDb, _
                                   acQuery, qdf.Name, qdf.Name, False
        End If
    Next qdf
 
    ' Reports.
    For Each obj In CurrentProject.AllReports
        DoCmd.TransferDatabase acExport, "Microsoft Access", sExtDb, _
                               acReport, obj.Name, obj.Name, False
    Next obj
 
    ' Tables.
    For Each tdf In CurrentDb.TableDefs
        If Left(tdf.Name, 4) <> "MSys" Then    'Ignore/Skip system tables
            DoCmd.TransferDatabase acExport, "Microsoft Access", sExtDb, _
                                   acTable, tdf.Name, tdf.Name, False
        End If
    Next tdf
 
Error_Handler_Exit:
    On Error Resume Next
    Set qdf = Nothing
    Set tdf = Nothing
    Set obj = Nothing
    Exit Sub
 
Error_Handler:
    MsgBox "The following error has occurred." & vbCrLf & vbCrLf & _
           "Error Number: " & Err.Number & vbCrLf & _
           "Error Source: ExpObj2ExtDb" & vbCrLf & _
           "Error Description: " & Err.Description, _
           vbCritical, "An Error has Occurred!"
    Resume Error_Handler_Exit
End Sub

ويتم التصدير من خلال الكود الاتى 

ExpObj2ExtDb ("D:\db.accdb")

طبعا تغير المسار واسم القاعدة مع الامتداد طبقا للقاعدة التى تريد التصدير اليها

وممكن تعمل كود يقوم بسؤال عن مكان القاعدة ليقوم هو بذلك بالنيابة عنك انت وافكارك 

[اسلام سيد]

25 دقائق مضت, ابا جودى said:

على العموم هذا موديول يقوم بعمل تصدير لكل شئ من قاعدة الى اخرى يمكنك تعديل ما تريد حسب احتياجاتك

Public Sub ExpObj2ExtDb(sExtDb As String)
    On Error GoTo Error_Handler
    Dim qdf             As QueryDef
    Dim tdf             As TableDef
    Dim obj             As AccessObject
 
    ' Forms.
    For Each obj In CurrentProject.AllForms
        DoCmd.TransferDatabase acExport, "Microsoft Access", sExtDb, _
                               acForm, obj.Name, obj.Name, False
    Next obj
 
    ' Macros.
    For Each obj In CurrentProject.AllMacros
        DoCmd.TransferDatabase acExport, "Microsoft Access", sExtDb, _
                               acMacro, obj.Name, obj.Name, False
    Next obj
 
    ' Modules.
    For Each obj In CurrentProject.AllModules
        DoCmd.TransferDatabase acExport, "Microsoft Access", sExtDb, _
                               acModule, obj.Name, obj.Name, False
    Next obj
 
    ' Queries.
    For Each qdf In CurrentDb.QueryDefs
        If Left(qdf.Name, 1) <> "~" Then    'Ignore/Skip system generated queries
            DoCmd.TransferDatabase acExport, "Microsoft Access", sExtDb, _
                                   acQuery, qdf.Name, qdf.Name, False
        End If
    Next qdf
 
    ' Reports.
    For Each obj In CurrentProject.AllReports
        DoCmd.TransferDatabase acExport, "Microsoft Access", sExtDb, _
                               acReport, obj.Name, obj.Name, False
    Next obj
 
    ' Tables.
    For Each tdf In CurrentDb.TableDefs
        If Left(tdf.Name, 4) <> "MSys" Then    'Ignore/Skip system tables
            DoCmd.TransferDatabase acExport, "Microsoft Access", sExtDb, _
                                   acTable, tdf.Name, tdf.Name, False
        End If
    Next tdf
 
Error_Handler_Exit:
    On Error Resume Next
    Set qdf = Nothing
    Set tdf = Nothing
    Set obj = Nothing
    Exit Sub
 
Error_Handler:
    MsgBox "The following error has occurred." & vbCrLf & vbCrLf & _
           "Error Number: " & Err.Number & vbCrLf & _
           "Error Source: ExpObj2ExtDb" & vbCrLf & _
           "Error Description: " & Err.Description, _
           vbCritical, "An Error has Occurred!"
    Resume Error_Handler_Exit
End Sub

السلام عليكم
كيف حالكم استاذنا الحبيب
ممكن توضيع باستفاضه لانى لم اصل لتلك المرحله المتقدمه ، واود ان اصل
اين يوضع هذا الكود
فى الملف الصادر ام الوارد
وفى اى حدث للزر
واين يوضع الكود الاخر بتاع تحديد المسار
وجزاكم الله كل خير

 

 

[بسام محرز]

ألف شكر .... سأقوم بتجريب هذا الكود و أتوقع الوصول إلى ما أريد ان شاء الله

[ابو جودي]

10 ساعات مضت, اسلام سيد said:

السلام عليكم
كيف حالكم
ممكن توضيع باستفاضه لانى لم اصل لتلك المرحله المتقدمه ، واود ان اصل
اين يوضع هذا الكود
فى الملف الصادر ام الوارد
وفى اى حدث للزر
واين يوضع الكود الاخر بتاع تحديد المسار
وجزاكم الله كل خير

وعليكم السلام اخى الحبيب 

الحمد لله رب العالمين فى نعمة بفضل الله ... جزاكم الله خيــــرا

عيونى أجهز لحضرتك مثال أكثر تقدما ومرونة من تلك الاجابة النظرية وعلى كل حال مبدئيا وختى يأذن الله تعالى بتنفيذ المثال اجيبك نظريا 

اين يوضع الكود فى موديول 
فى القاعدة التى تريد التصدير منها 
فى اى حدث لك مطلق الحرية لانه يمكنك استدعاء الروتين من اى مكان تريد فى القاعدة 
وكود المسار يوضع فى الحدث حيث اننا سوف نقوم باسناد المساؤ الى المتغير الذى تم الاعلان عنه فى الروتين 

حيث اننا نستدعى الروتين بهذا الشكل ليقوم بتنفيذ ما تم كتابته به

ExpObj2ExtDb("D:\اسم القاعدة التى نريد التصدير اليها + الامتداد الخاص بها")

فيكون بذلك الشكل 

ExpObj2ExtDb("D:\Db.accdb")

or 

ExpObj2ExtDb("D:\Db.mdb")

لاحظ بين القوسين هذا المتغير sExtDb As String الذى تم الاعلان عنه وهو من النوع النصر وهو الذى سوف نسد اليه المسار فيكون كالاتى 
 

واتمنى ان تقرأ هذه المشاركة بعناية وبهدوء وصبر لانها سوف تفيدك جدا جدا جدا ان شاء الله واعتذر مسبقا لان المقال كبير قليلا الا أنه مهم جدا جدا جدا وان شاء الله به فوائد كثيرة 

 

[بسام محرز]

ألف شكر صديقي العزيز و جزاك الله خيراً .....لقد عمل الكود تماماً كما أردت ...... و لكن طمعاً بكرمك أريد معرفة التغيير الذي يجب أن أجريه على هذا الكود لعكس العملية أي لاستيراد هذه الكائنات ... و لك جزيل الشكر

[ابو جودي]

في ٢٨‏/١٢‏/٢٠٢٠ at 11:04, بسام محرز said:

الأخوة الأعزاء ... أريد كود تصدير كائن من أكسس إلى أكسس مع إمكانية استبدال الكائن القديم بالجديد مباشرة دون السؤال ....  و لكم جزيل الشكر

------------

في ٢٨‏/١٢‏/٢٠٢٠ at 11:49, اسلام سيد said:

ممكن توضيع باستفاضه لانى لم اصل لتلك المرحله المتقدمه ، واود ان اصل
اين يوضع هذا الكود
فى الملف الصادر ام الوارد
وفى اى حدث للزر
واين يوضع الكود الاخر بتاع تحديد المسار

وكنت قد وعدتكم بإرفاق مثال أكثر تقدما ومرونة من تلك الاجابة النظرية..

وقت الوفاء بالعهد

تفضلوا