اذهب الي المحتوي
أوفيسنا
بحث مخصص من جوجل فى أوفيسنا
Custom Search

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

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

بواسطه سلمان الشهراني
في قسم الأكسيس Access

 مشاركة
إذهب إلى الإجابة الإجابة بواسطة Foksh,

الردود الموصى بها

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

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

قام بنشر
قام بنشر (معدل)

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

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

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

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

 

Zakat.rar

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

ابوخليل

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


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

 

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

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

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

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

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

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

  • Like 1
سلمان الشهراني

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

قام بنشر
  • الكاتب
قام بنشر (معدل)

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

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

ابوخليل

قام بنشر
قام بنشر

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

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

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

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

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

قام بنشر
  • الكاتب
قام بنشر

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

 

ابوخليل

ابوخليل

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

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

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

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


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

 

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

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

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

  • Thanks 1
Foksh

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

 

.

تم تعديل بواسطه Foksh
تعديل خطأ إملائي
  • Like 1
  • Thanks 1
سلمان الشهراني

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

قام بنشر
  • الكاتب
قام بنشر (معدل)
7 ساعات مضت, Foksh said:

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

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

المرفق والعمل ممتااااز جدا وقمة الابداع ولكن يحتاج بعض الاضافات والتعديل
اولا طال عمرك رقم الفاتورة هو حقل ID وهو الحقل الذي يتم التعامل معه في المقارنه او عمليات الاسترجاع وهو رقم الفاتورة الخاص بالزكاة والدخل
اما بنسبه لحقل ID2 وحقل InvoiceNumber  فهي ارقام خاصه بالنظام غير مهمه في عملية الترحيل او الاسترجاع 
 

المطلوب اضافته  
1- امكانية تحديد مسار القاعده Zakat2 ليتم عملية الترحيل والاسترجاع لها ومنها حسب المسار المحدد
2- اعتماد حقل ID هل حقل الفاتورة ويتم التعامل معه فقط 
3- عند عملية استرجاع الفاتورة برقم الفاتورة (ID)  للقاعده Zakat1 يتم حذفه مره اخرى من القاعده Zakat1 مع اول عملية حذق بناء على المده 30  مع العلم انه لابد ان يبقى في القاعده Zakat2 بعد الاسترجاع 
3- لوحظ حاليا انه في الجدول الفرعي عند الترحيل لايتم نقلها بالشكل الصحيح كماهي في القاعده الاساسيه

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

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

Foksh

قام بنشر
قام بنشر
3 ساعات مضت, سلمان الشهراني said:

1- امكانية تحديد مسار القاعده Zakat2 ليتم عملية الترحيل والاسترجاع لها ومنها حسب المسار المحدد

3 ساعات مضت, سلمان الشهراني said:

2- اعتماد حقل ID هل حقل الفاتورة ويتم التعامل معه فقط 

تم التعديل بإذن الله ..

4 ساعات مضت, سلمان الشهراني said:

3- عند عملية استرجاع الفاتورة برقم الفاتورة (ID)  للقاعده Zakat1 يتم حذفه مره اخرى من القاعده Zakat1 مع اول عملية حذق بناء على المده 30  مع العلم انه لابد ان يبقى في القاعده Zakat2 بعد الاسترجاع 

تم التعديل بحيث عند استرجاع فاتورة ( جرب على الفاتورة رقم 4 حيث تم التعديل للتاريخ = 2024-11-16 للتجربة) ، سيتم سؤال المستخدم انه هذه الفاتورة مضى عليها أكثر من 30 يوم ، هل تريد الحذف ( الأمر متروك للمستخدم بالحذف أو لا ..)

4 ساعات مضت, سلمان الشهراني said:

4- لوحظ حاليا انه في الجدول الفرعي عند الترحيل لايتم نقلها بالشكل الصحيح كماهي في القاعده الاساسيه

في اي جزء لاحظت انه لا يتم الترحيل بشكل صحيح ...؟ فبناءً على الملف المرفق تمت التجربة على السجلات بشكل منفصل والتدقيق قبل وبعد الترحيل أو الإستيراد . اذا تمكنت من ارفاق صورة أو توضيح لتلافي المشكلة ، وأكيد في الأمور المالية والحسابية الخطأ يكون قاتلاً :blink:

 

Zakat.zip

 

  • Thanks 1
ابوخليل

ابوخليل

قام بنشر
قام بنشر

ما شاء الله لا قوة الا بالله .. اخي فادي ولا اجمل .. سلمت أناملك

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

الحقيقة هذه الجمل البرمجية الجميلة تدرس وتحفظ كمرجع  مهم للغاية

لذا تم السطو على كم سطر منها .. :wavetowel: فأعتذر .. زادك الله علما

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

الفكرة التي يجب ان يكون تصميم الجداول قائم عليه كالتالي :

1- وجود حقل غير قابل للتكرار في جميع الجداول خاصة الجدول الفرعي الخارجي

2- خصائص العلاقة بين الجدول الرئيس والفرعي ( في القاعدة الحالية لاباس من توالي التحديث والحذف وهو جيد لاختصار عملية الحذف .. اما في القاعدة الخارجية فممنوع ويكفي التكامل فقط)

3- اضافة حقل نعم لا  من اجل تأكيد التصدير وايضا الحذف

4- عمل تصفية بين تاريخين لحصر السجلات المراد اجراء العمليات عليها

5- لا يلزم الانتظار لشهر او غيره في عملية الحذف وانما تتم مباشرة بعد الترحيل

تم العمل على النحو التالي وهي وجهة نظر تخصني وتحقيقا لما تفضل السائل بتأكيده : ((( وكما ذكرت ان هذه الفواتير خاصه بالزكاة والدخل ولاتحتمل الخطاء )))

لذا :

لا يسمح باختيار قاعدة الببانات الخارجية من قبل المستخدم وانما توضع بجانب قاعدة البيانات الاساسية

تم الضبط ولا خوف من اي خطأ مقصود او غير مقصود

هذا للترحيل والحذف : 

 Dim strPath As String
      strPath = CurrentProject.Path & "\Zakat2.accdb"
        
        DoCmd.SetWarnings False
          DoCmd.RunSQL "INSERT INTO [;DATABASE=" & strPath & "].TBInvoiceMain2 " & _
                       "SELECT TBInvoiceMain.* FROM TBInvoiceMain " & _
            "WHERE TBInvoiceMain.chekForDel=True"

          DoCmd.RunSQL "INSERT INTO [;DATABASE=" & strPath & "].TBInvoiceSub2 " & _
                       "SELECT TBInvoiceSub.* FROM TBInvoiceMain " & _
         "INNER JOIN TBInvoiceSub ON TBInvoiceMain.ID = TBInvoiceSub.ID " & _
         "WHERE TBInvoiceMain.chekForDel=True"
      
      DoCmd.RunSQL "DELETE TBInvoiceMain.*, TBInvoiceMain.chekForDel FROM TBInvoiceMain " & _
"WHERE TBInvoiceMain.chekForDel=True"
          DoCmd.SetWarnings True

وهذا للاسترجاع : 

lngInvoiceNumber = CLng(Trim(Me.Text1))
    DoCmd.SetWarnings False
       DoCmd.RunSQL "INSERT INTO TBInvoiceMain " & _
             "SELECT * FROM [;DATABASE=" & strPath & "].TBInvoiceMain2 " & _
             "WHERE InvoiceNumber = " & lngInvoiceNumber
       DoCmd.RunSQL "INSERT INTO TBInvoiceSub " & _
             "SELECT * FROM [;DATABASE=" & strPath & "].TBInvoiceSub2 " & _
             "WHERE InvoiceNumber = " & lngInvoiceNumber
    DoCmd.SetWarnings True
MsgBox "تم الاسترجاع", , ""

 

Zakat.rar

  • Thanks 2
Foksh

Foksh

قام بنشر
قام بنشر
16 دقائق مضت, ابوخليل said:

لذا تم السطو على كم سطر منها .. :wavetowel: فأعتذر .. زادك الله علما

 

وإياكم أستاذنا الكبير @ابوخليل ، بعض ما عندكم أثابنا وأثابكم الله :wub:

 

استولي على ما شئت :yes: ، فهذا تعليمكم 

 

أما بالنسبة لتعديلاتي الأخيرة ، فقد كانت حسب رغبة أخونا الكريم @سلمان الشهراني ، وطبعاً لا شك فيما تفضلتم به من اقتراحات خاصة ببناء الجداول .

  • Thanks 1
سلمان الشهراني

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

قام بنشر
  • الكاتب
قام بنشر (معدل)
56 دقائق مضت, ابوخليل said:

نا كنت اعمل على طلب الأخ سلمان وقت طلب مني

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

تم تعديل بواسطه سلمان الشهراني
  • Like 2
ابوخليل

ابوخليل

قام بنشر
قام بنشر

هذا الموضوع اعتبره فريد من نوعه  وخاصة بتفاصيله

لو بحث احد عن مثله لن يجد بغيته الا هنا في هذا المنتدى وهذا الموضوع بالذات

تنوع الأفكار وتنوع الحلول مطلب برمجي

بارك الله في الجميع

  • Like 1
Foksh

Foksh

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

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

أعانكم الله على ما بدأتم ،، ونسأل الله التوفيق لنا ولكم ، ومتابع معك إن شاء الله بتكاتف الجهود طبعاً 

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

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

قام بنشر
  • الكاتب
قام بنشر (معدل)
12 ساعات مضت, Foksh said:

أعانكم الله على ما بدأتم ،، ونسأل الله التوفيق لنا ولكم ، ومتابع معك إن شاء الله بتكاتف الجهود طبعاً 

استاذي الغالي التعديل جميل جداً وقمه في الابداع ولكن تحملنا قليل ونحتاج بعض الاضافات والتعديل


1- المطلوب اضافته هو اضافة شرط عند الترحيل من القاعده Zakat1 الى القاعده رقم Zakat2 والشرط هو ان ترحل فقط الفواتير التي الحقل (ZatcaXMLSent) يساوي (نعم) وهذا الحقل الموجود في جدول (TBInvoiceMain)

 

2- يكون تحديد مسار قاعدة البيانات مره واحده عن طريق مربع نص ويتم حفظ هذا المسار لمره واحده فقط

3- اضافة حقل جديد في جدول (TBInvoiceMain) في القاعده Zakat1 عباره عن (نعم /  لا) حتى يميز الفواتير التي تم استرجاعها حيث يصبح الحقل (نعم) اذا تم استراجاعها وهذي فكرة استاذي ابو خليل في الفقره قم 3 ولكن تم التعديل عليها

5- عند الاسترجاع يتم اظهار رسالة للمستخدم ان هذه الفاتورة تفيده بوجود فاتورة قديمة هل يرغب في حذفها (المطلوب الغاء الحذف لانه  لا يتم استرجاعها الا لطباعتها مره اخرى)

 

4- لوحظ بعد استرجاع الفاتورة رقم 4 تم استرجاعها بشكل صحيح ولكن عند اضافة سجل جديد بعد الاسترجاع فانه يعطي الترقيم التلقائي رقم يلي الرقم المسترجع
مثال : تم استرجاع فاتورة رقم 4 وعند اضافة سجل جديد يعطي رقم 5  وهنا يصبح تكرار ولا يقبل الإضافة

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

Foksh

قام بنشر
قام بنشر

تم قراءة التفاصيل المطلوبة ، وإن شاء الله بالقريب سيتم الرد بالتعديلات حال وصولي للكمبيوتر 🤗 .

 

 

في النقطة 4 تتوقف الأمور على أن رقم الفاتورة المعتمد هو الحقل ID وهو حقل ترقيم تلقائي ، صحيح ؟؟؟

وهنا سبب مشكلتك في الترقيم 

Foksh

Foksh

قام بنشر
قام بنشر

تفضل أخي @سلمان الشهراني ، تعديلاتي للنقاط ( 1 و 2 و 3 ) فقط !! النقطة 5 لم استفهمها بشكل واضح .

 

تعديلاتي التي تمت :-

1. إضافة مربع نص Zak_Path لتسجيل المسار به عند اختيار ملف القاعدة المستهدفة لترحيل البيانات لها .
2. تم اضافة حقل جديد = Tran من نوع Yes/No في جدول (TBInvoiceMain) في القاعده Zakat1 ، حتى يمييز الفواتير التي تم استرجاعها . بحيث يصبح الحقل (Yes = -1) اذا تم استراجاعه .

التعديلات في كود زر الترحيل كالتالي :- 

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 intCount As Integer
    Dim fd As Office.FileDialog
    
    If IsNull(Me.Zak_Path.Value) Or Me.Zak_Path.Value = "" Then
        Set fd = Application.FileDialog(msoFileDialogFilePicker)
        
        With fd
            .Title = "اختر ملف قاعدة البيانات"
            .Filters.Clear
            .Filters.Add "قواعد بيانات Access", "*.accdb"
            .AllowMultiSelect = False
            
            If .Show = -1 Then
                Me.Zak_Path.Value = .SelectedItems(1)
            Else
                MsgBox "لم يتم اختيار ملف", vbExclamation + vbMsgBoxRight, ""
                Exit Sub
            End If
        End With
    End If
    
    strPath2 = Me.Zak_Path.Value
    
    Set db1 = CurrentDb
    Set db2 = DBEngine.OpenDatabase(strPath2)
    
    strCheck = "SELECT COUNT(*) AS NewCount " & _
               "FROM TBInvoiceMain " & _
               "WHERE ZatcaXMLSent = -1 AND 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 ZatcaXMLSent = -1 AND ID NOT IN " & _
             "(SELECT ID 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 ID = " & rst1!ID
            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 ID = " & rst1!ID
                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
    Dim fd As Office.FileDialog
    Dim intDeletedCount As Integer
    
    Set fd = Application.FileDialog(msoFileDialogFilePicker)
    
    With fd
        .Title = "اختر ملف قاعدة البيانات"
        .Filters.Clear
        .Filters.Add "قواعد بيانات Access", "*.accdb"
        .AllowMultiSelect = False
        
        If .Show = -1 Then
            strPath2 = .SelectedItems(1)
        Else
            MsgBox "لم يتم اختيار ملف", vbExclamation + vbMsgBoxRight, ""
            Exit Sub
        End If
    End With
    
    lngInvoiceNumber = CLng(Trim(Me.Text1))
    
    Set db1 = CurrentDb
    Set db2 = DBEngine.OpenDatabase(strPath2)
    
    strSQL = "SELECT COUNT(*) AS InvCount " & _
             "FROM [;DATABASE=" & strPath2 & "].TBInvoiceMain2 " & _
             "WHERE ID = " & 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 ID = " & 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 ID = " & lngInvoiceNumber
    
    db1.Execute strSQL
    
    strSQL = "INSERT INTO TBInvoiceSub " & _
             "SELECT * FROM [;DATABASE=" & strPath2 & "].TBInvoiceSub2 " & _
             "WHERE ID = " & lngInvoiceNumber
    
    db1.Execute strSQL
    
    strSQL = "UPDATE TBInvoiceMain SET Tran = -1 WHERE ID = " & lngInvoiceNumber
    db1.Execute strSQL
    
    MsgBox "تم استرجاع الفاتورة رقم " & lngInvoiceNumber & " بنجاح", vbInformation + vbMsgBoxRight, ""
    
    strSQL = "SELECT COUNT(*) AS OldCount " & _
             "FROM TBInvoiceMain " & _
             "WHERE DateDiff('d', InvoiceDate, Date()) > 30"
    
    Set rst1 = db1.OpenRecordset(strSQL)
    
    If rst1!OldCount > 0 Then
        If MsgBox("يوجد " & rst1!OldCount & " فاتورة مضى عليها أكثر من 30 يوماً . هل تريد حذفها؟", _
                  vbQuestion + vbYesNo + vbMsgBoxRight, "") = vbYes Then
            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
            
            MsgBox "تم حذف " & rst1!OldCount & " فاتورة قديمة بنجاح", vbInformation + vbMsgBoxRight, ""
        Else
            MsgBox "لم يتم حذف الفواتير القديمة", vbInformation + vbMsgBoxRight, ""
        End If
    Else
        MsgBox "لا توجد فواتير مضى عليها أكثر من 30 يومًا", vbInformation + vbMsgBoxRight, ""
    End If
    
    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

 

الملف = 

Zakat.zip

  • Thanks 1
سلمان الشهراني

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

قام بنشر
  • الكاتب
قام بنشر
3 ساعات مضت, Foksh said:

لنقطة 5 لم استفهمها بشكل واضح

1-   بنسبه للنقطه رقم 5 هو ان الحذف يكون عند عملية الترحيل فقط اما عملية الاسترجاع لايكون هناك حذف للفواتير

(مرفق صورة توضيحيه)

 

2-   مربع النص الخاص بمسار قاعدة البيانات ممتاز جداً ولكن نتمنى يضاف في الشاشة الثانية FormZakat2

3-   اما بنسبه للخلل الذي يحدث للترقيم التلقائي الخاص بالفواتير عند الاسترجاع فسوف احاول تعديل خصائص الحقل الى رقم لتجنب هذا الخطاء

 

ملاحظة : تم ارفاق الملفات من جديد لكون حقل ZatcaXMLSent لايظهر عند عرض الجدول ولكن تم اصلاحه ورفع الملفات من جديد

 

المرفقات .rar

  • تمت الإجابة
Foksh

Foksh

قام بنشر
  • تمت الإجابة
قام بنشر (معدل)
2 ساعات مضت, سلمان الشهراني said:

حقل ZatcaXMLSent لايظهر عند عرض الجدول

بالعكس :excl: الحقل يظهر ، لكن المشكلة واعتقد انها بسبب فرق اصدار الأوفيس ، أن قيم الحقل = نعم / لا على عكس الحقل الذي قمت انا بإضافته لتمييز السجلات التي تم استرجاعها .

على العموم ، تفضل هذا المرفق يا صديقي بعد التعديلات التي طلبتها ..

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

كود الترحيل ( التصدير ) :- 

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 intCount As Integer
    Dim fd As Office.FileDialog
    
    If IsNull(Me.Zak_Path.Value) Or Me.Zak_Path.Value = "" Then
        Set fd = Application.FileDialog(msoFileDialogFilePicker)
        
        With fd
            .Title = "اختر ملف قاعدة البيانات"
            .Filters.Clear
            .Filters.Add "قواعد بيانات Access", "*.accdb"
            .AllowMultiSelect = False
            
            If .Show = -1 Then
                Me.Zak_Path.Value = .SelectedItems(1)
            Else
                MsgBox "لم يتم اختيار ملف", vbExclamation + vbMsgBoxRight, ""
                Exit Sub
            End If
        End With
    End If
    
    strPath2 = Me.Zak_Path.Value
    
    Set db1 = CurrentDb
    Set db2 = DBEngine.OpenDatabase(strPath2)
    
    strCheck = "SELECT COUNT(*) AS NewCount " & _
               "FROM TBInvoiceMain " & _
               "WHERE ZatcaXMLSent = -1 AND 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 ZatcaXMLSent = -1 AND ID NOT IN " & _
             "(SELECT ID 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 ID = " & rst1!ID
            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 ID = " & rst1!ID
                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
    Dim fd As Office.FileDialog
    Dim intDeletedCount As Integer
    
    If IsNull(Me.Zak_Path.Value) Or Me.Zak_Path.Value = "" Then
        Set fd = Application.FileDialog(msoFileDialogFilePicker)
        
        With fd
            .Title = "اختر ملف قاعدة البيانات"
            .Filters.Clear
            .Filters.Add "قواعد بيانات Access", "*.accdb"
            .AllowMultiSelect = False
            
            If .Show = -1 Then
                Me.Zak_Path.Value = .SelectedItems(1)
            Else
                MsgBox "لم يتم اختيار ملف", vbExclamation + vbMsgBoxRight, ""
                Exit Sub
            End If
        End With
    End If
    
    strPath2 = Me.Zak_Path.Value
    
    lngInvoiceNumber = CLng(Trim(Me.Text1))
    
    Set db1 = CurrentDb
    Set db2 = DBEngine.OpenDatabase(strPath2)
    
    strSQL = "SELECT COUNT(*) AS InvCount " & _
             "FROM [;DATABASE=" & strPath2 & "].TBInvoiceMain2 " & _
             "WHERE ID = " & 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 ID = " & 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 ID = " & lngInvoiceNumber
    
    db1.Execute strSQL
    
    strSQL = "INSERT INTO TBInvoiceSub " & _
             "SELECT * FROM [;DATABASE=" & strPath2 & "].TBInvoiceSub2 " & _
             "WHERE ID = " & lngInvoiceNumber
    
    db1.Execute strSQL
    
    strSQL = "UPDATE TBInvoiceMain SET Tran = -1 WHERE ID = " & 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

 

إلى الآن هل الأمور تسير كما نريد ؟؟

المرفقات.zip

تم تعديل بواسطه Foksh
  • Thanks 1
سلمان الشهراني

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

قام بنشر
  • الكاتب
قام بنشر
18 ساعات مضت, Foksh said:

إلى الآن هل الأمور تسير كما نريد ؟؟

 

واكثر مما كنا نريد فجزاك الله خير الجزاء وبيض الله وجهك وزادك الله من علمه وعاجز عن الشكر لك اخي ومعلمي الغالي
واشكر استاذي ابو ابوخليل والاستاذ الغالي kkhalifa1960   على ماقدموه من مشاركة وافكار جميله 
واسمحو لي سوف اقوم الايام المقبله بإضافة فواتير باعداد كبيره واختبار الملفات بشكل دقيق  ولو حدث معاي اي ملاحظة سوف اقوم بإبلاغكم على هذا الموضوع 
تحياتي للجميع

  • Thanks 1

انشئ حساب جديد او قم بتسجيل دخولك لتتمكن من اضافه تعليق جديد

يجب ان تكون عضوا لدينا لتتمكن من التعليق

انشئ حساب جديد

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

سجل حساب جديد

تسجيل دخول

هل تمتلك حساب بالفعل ؟ سجل دخولك من هنا.

سجل دخولك الان
 مشاركة
الذهاب الي قائمه المواضيع
×
×
  • اضف...

Important Information

  I accept