ترحيل فواتير من قاعدة بيانات الى قاعدة اخرى دون وجود ربط بينهما

[سلمان الشهراني]

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

لدي قاعدتين ( Zakat1 و Zakat2 ) تحتوي على نفس الجداول والحقول مع اضافة رقم 2 فقط في اسماء جداول القاعدة Zakat2

ويوجد في القاعده Zakat1 نموذجين FormZakat1 و FormZakat2
المطلوب 
1- عند فتح نموذج FormZakat1 يقوم بالبحث عن الفواتير الموجوده بالقاعده Zakat1 وليست موجوده بالقاعده Zakat2 ومن ثم يقوم بترحيلها كامله سوى الجدول الرئيسي او الفرعي ثم تحذف هذه الفواتير من الجداول بعد فترة زمنيه محدده مثلاً (30) يوم 
2- عند فتح نموذج FormZakat2 يقوم بإسترجاع الفاتورة المحدده في المربع Text1 من القاعده Zakat2 الى القاعده Zakat1 شرط ان تكون بنفس رقم الفاتورة ولا يتم حذفها من القاعده Zakat2

ملاحظة
ارغب ان لايكون هناك علاقة بين القاعدتين عن طريق الجداول المرتبطه ان امكن

 

Zakat.rar

تم تعديل منذ 19 ساعات بواسطه سلمان الشهراني

[ابوخليل]

23 دقائق مضت, سلمان الشهراني said:

1- عند فتح نموذج FormZakat1 يقوم بالبحث عن الفواتير الموجوده بالقاعده Zakat1 وليست موجوده بالقاعده Zakat2 

 

عليكم السلام .. اهلا ابا حاتم

رأيي ان تستغني عن عملية البحث هذه .. لتجنب بعض المحاذير التي قد تحدث

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

اما عملية الحذف فهي ايضا خطيرة لأننا نضع في اعتبارنا جميع الاحتمالات ( قد لا تصل السجلات الى القاعدة الثانية لأسباب عدة يعرفها غالب المبرمجين )

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

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

[سلمان الشهراني]

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

تم تعديل منذ 19 ساعات بواسطه سلمان الشهراني

[ابوخليل]

قصدي انها لا يتم حذفها مباشرة .. وهذا الذي ذكرته انت ان يتم حذفها بعد شهر

الحذف الآلي لا انصح به

ما المانع ان يكون هناك زر للحذف وحقل يبين عدد السجلات وتاريخ ترحيلها .. بل حقول .. لنفترض ان الترحيل يتم كل 10 ايام  .. يتم عرض نموذج مستمر  كل سجل امامه زر للحذف وفي السجل حقلين واحد بعدد السجلات والآخر تاريخ الترحيل .

[سلمان الشهراني]

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

 

[ابوخليل]

27 دقائق مضت, سلمان الشهراني said:

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

كل ترحيل عبارة عن مجموعة من السجلات .. يتم لاحقا حذفها جملة بزر بامر واحد .. راجع مشاركتي السابقة جيدا

30 دقائق مضت, سلمان الشهراني said:

اتمنى اجد حل سهل وعملي وفيه امان عالي على البيانات وخاصه انها خاصه بالزكاة والدخل

 

من اجل هذا  كتبت رؤيتي حول العملية .. حول نقطتين او اجرائين في فكرتك الأصلية :

1- المقارنة بين السجلات في قاعدتين متباعدتين 

1- الحذف الآلي

[سلمان الشهراني]

طيب ممكن يتم تطبقها على المثال اخي الغالي ابو خليل
واتمنى نشوف افكار من الاخوان والاساتذه الكرام

تم تعديل منذ 15 ساعات بواسطه سلمان الشهراني

[kkhalifa1960]

استاذ @سلمان الشهراني ممكن استخدام هذه الفكرة كما بالمرفق لكن ماينفع معها علاقات . جرب زياد ادخالات .ووافني بالرد .

Zakat-1.rar

[Foksh]

وعليكم السلام ورحمة الله وبركاته أستاذ @سلمان الشهراني ، لي مداخلة بسيطة :-

في مثالك لاحظت ان رقم الفاتورة مكرر في سجلات القاعدة الأولى ، هل هذا منطقي أم هو مجرد مثال ؟؟

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

على العموم إليك اقتراحي :-

في زر الترحيل الى القاعدة الأولى استخدم الكود التالي :-

Private Sub COM1_Click()
    On Error GoTo ErrorHandler
    
    Dim db1 As DAO.Database
    Dim db2 As DAO.Database
    Dim rst1 As DAO.Recordset
    Dim rstCheck As DAO.Recordset
    Dim strSQL As String
    Dim strCheck As String
    Dim strPath2 As String
    Dim intCount As Integer
    
    strPath2 = CurrentProject.Path & "\Zakat2.accdb"
    
    Set db1 = CurrentDb
    Set db2 = DBEngine.OpenDatabase(strPath2)
    
    strCheck = "SELECT COUNT(*) AS NewCount " & _
               "FROM TBInvoiceMain " & _
               "WHERE ID NOT IN " & _
               "(SELECT ID FROM [;DATABASE=" & strPath2 & "].TBInvoiceMain2)"
               
    Set rstCheck = db1.OpenRecordset(strCheck)
    If Not rstCheck.EOF Then
        If rstCheck!NewCount = 0 Then
            MsgBox "لا توجد فواتير جديدة للترحيل", vbInformation + vbMsgBoxRight, ""
            GoTo CleanUp
        End If
        
        If MsgBox("سيتم نقل " & rstCheck!NewCount & " فاتورة . هل تريد المتابعة؟", _
                  vbQuestion + vbMsgBoxRight + vbYesNo, "") = vbNo Then
            GoTo CleanUp
        End If
    End If
    
    strSQL = "SELECT DISTINCT TBInvoiceMain.* " & _
             "FROM TBInvoiceMain " & _
             "WHERE InvoiceNumber NOT IN " & _
             "(SELECT InvoiceNumber FROM [;DATABASE=" & strPath2 & "].TBInvoiceMain2)"
    
    Set rst1 = db1.OpenRecordset(strSQL)
    intCount = 0
    
    If Not rst1.EOF Then
        Do While Not rst1.EOF
            On Error Resume Next
            
            strSQL = "INSERT INTO [;DATABASE=" & strPath2 & "].TBInvoiceMain2 " & _
                    "SELECT ID, ID2, InvoiceNumber, FormNumber, InvoiceType, UUID, " & _
                    "InvoiceSerial, InvoiceDate, InvoiceTime, InvoiceTypeCodeID, " & _
                    "InvoiceTypeCodeName, InvoiceHash, DateSupply, EndDateSupply, " & _
                    "PaymentMethod, InstructionNote, TotalDiscount, DiscountReason, " & _
                    "TaxCode, TaxCodeName, TaxPercentage, InvoiceQR, InvoiceXmlName, " & _
                    "InvoiceXmlFullPath, EncodedInvoice, XMLCreated, SendingStatus, " & _
                    "ZatcaStatusCode, ZatcaXMLSent, ZatcaWarningMessage, ZatcaErrorMessage, " & _
                    "ClearedInvoice, BuyerStreetName, BuyerAdditionalStreetName, " & _
                    "BuyerBuildingNumber, BuyerPlotIdEntification, BuyerCityName, " & _
                    "BuyerPostalCode, BuyerCountrySubEntity, BuyerCitySubDivisionName, " & _
                    "BuyerCompanyName, BuyerTaxNumber, clearedXmlFullPath, BuyerCommercialRegistrationNo " & _
                    "FROM TBInvoiceMain WHERE InvoiceNumber = " & rst1!InvoiceNumber
            db1.Execute strSQL
            
            If Err.Number = 0 Then
                
                strSQL = "INSERT INTO [;DATABASE=" & strPath2 & "].TBInvoiceSub2 " & _
                        "SELECT ID, InvoiceNumber, ItemName, Quantity, ItemPriceBeforeTax, " & _
                        "TaxPercentage, TaxCode, Discount " & _
                        "FROM TBInvoiceSub WHERE InvoiceNumber = " & rst1!InvoiceNumber
                db1.Execute strSQL
                
                If Err.Number = 0 Then
                    intCount = intCount + 1
                End If
            End If
            
            On Error GoTo ErrorHandler
            rst1.MoveNext
        Loop
        
        strSQL = "DELETE TBInvoiceSub.* " & _
                 "FROM TBInvoiceSub INNER JOIN TBInvoiceMain ON TBInvoiceMain.ID = TBInvoiceSub.ID " & _
                 "WHERE DateDiff('d', TBInvoiceMain.InvoiceDate, Date()) > 30"
        db1.Execute strSQL
        
        strSQL = "DELETE TBInvoiceMain.* " & _
                 "FROM TBInvoiceMain " & _
                 "WHERE DateDiff('d', InvoiceDate, Date()) > 30"
        db1.Execute strSQL
        
        If intCount > 0 Then
            MsgBox "تم ترحيل " & intCount & " فاتورة بنجاح" & vbCrLf & _
                   "وتم حذف الفواتير الأقدم من 30 يوم", vbInformation + vbMsgBoxRight, ""
        Else
            MsgBox "لم يتم ترحيل أي فواتير", vbInformation + vbMsgBoxRight, ""
        End If
    End If
    
CleanUp:
    If Not rst1 Is Nothing Then rst1.Close
    If Not rstCheck Is Nothing Then rstCheck.Close
    Set rst1 = Nothing
    Set rstCheck = Nothing
    If Not db2 Is Nothing Then db2.Close
    Set db2 = Nothing
    Exit Sub
    
ErrorHandler:
    MsgBox "حدث خطأ أثناء عملية الترحيل", vbCritical + vbMsgBoxRight, ""
    Resume CleanUp
End Sub

 

أما في نموذج استرجاع رقم فاتورة محدد ، استخدم الكود التالي :-

Private Sub COM1_Click()
    On Error GoTo ErrorHandler
    
    If IsNull(Me.Text1) Or Trim(Me.Text1) = "" Then
        MsgBox "الرجاء إدخال رقم الفاتورة المطلوب استرجاعها", vbExclamation + vbMsgBoxRight, ""
        Me.Text1.SetFocus
        Exit Sub
    End If
    
    If Not IsNumeric(Me.Text1) Then
        MsgBox "الرجاء إدخال رقم فاتورة صحيح", vbExclamation + vbMsgBoxRight, ""
        Me.Text1.SetFocus
        Exit Sub
    End If
    
    Dim db1 As DAO.Database
    Dim db2 As DAO.Database
    Dim rst1 As DAO.Recordset
    Dim strSQL As String
    Dim strPath2 As String
    Dim lngInvoiceNumber As Long
    
    strPath2 = CurrentProject.Path & "\Zakat2.accdb"
    lngInvoiceNumber = CLng(Trim(Me.Text1))
    
    Set db1 = CurrentDb
    Set db2 = DBEngine.OpenDatabase(strPath2)
    
    strSQL = "SELECT COUNT(*) AS InvCount " & _
             "FROM [;DATABASE=" & strPath2 & "].TBInvoiceMain2 " & _
             "WHERE InvoiceNumber = " & lngInvoiceNumber
    
    Set rst1 = db1.OpenRecordset(strSQL)
    
    If rst1!InvCount = 0 Then
        MsgBox "الفاتورة رقم " & lngInvoiceNumber & " غير موجودة في قاعدة البيانات الثانية", vbExclamation + vbMsgBoxRight, ""
        GoTo CleanUp
    End If
    
    strSQL = "SELECT COUNT(*) AS InvCount FROM TBInvoiceMain " & _
             "WHERE InvoiceNumber = " & lngInvoiceNumber
    
    Set rst1 = db1.OpenRecordset(strSQL)
    
    If rst1!InvCount > 0 Then
        If MsgBox("الفاتورة موجودة بالفعل في القاعدة الحالية . هل تريد استرجاعها مرة أخرى؟", _
                  vbQuestion + vbYesNo + vbMsgBoxRight, "") = vbNo Then
            GoTo CleanUp
        End If
    End If
    
    strSQL = "INSERT INTO TBInvoiceMain " & _
             "SELECT * FROM [;DATABASE=" & strPath2 & "].TBInvoiceMain2 " & _
             "WHERE InvoiceNumber = " & lngInvoiceNumber
    
    db1.Execute strSQL
    
    strSQL = "INSERT INTO TBInvoiceSub " & _
             "SELECT * FROM [;DATABASE=" & strPath2 & "].TBInvoiceSub2 " & _
             "WHERE InvoiceNumber = " & lngInvoiceNumber
    
    db1.Execute strSQL
    
    MsgBox "تم استرجاع الفاتورة رقم " & lngInvoiceNumber & " بنجاح", vbInformation + vbMsgBoxRight, ""
    
    Me.Text1 = ""
    Me.Text1.SetFocus
    
CleanUp:
    If Not rst1 Is Nothing Then rst1.Close
    Set rst1 = Nothing
    If Not db2 Is Nothing Then db2.Close
    Set db2 = Nothing
    Exit Sub
    
ErrorHandler:
    MsgBox "حدث خطأ أثناء عملية الاسترجاع", vbCritical + vbMsgBoxRight, ""
    Resume CleanUp
End Sub

 

تم الإعتماد هنا على رقم الفاتورة من الحقل InvoiceNumber ، وأخبرني بالنتيجة .

 

المرفق بعد التعديل ..

Zakat.zip

 

.

تم تعديل منذ 6 ساعات بواسطه Foksh
تعديل خطأ إملائي

[سلمان الشهراني]

8 ساعات مضت, kkhalifa1960 said:

استاذ @سلمان الشهراني ممكن استخدام هذه الفكرة كما بالمرفق لكن ماينفع معها علاقات . جرب زياد ادخالات .ووافني بالرد .

 

عمل جميل وفكرة جميله تسلم وفقك الله والف شكر