ابو جودي

اتفضل SELECT t1.namee, t1.reg_date AS MaxDate, t1.amount FROM Table1 AS t1 WHERE t1.reg_date = ( SELECT MAX(t2.reg_date) FROM Table1 AS t2 WHERE t2.namee = t1.namee ); الطريقة الثانيه SELECT t1.namee, t1.reg_date AS MaxDate, t1.amount FROM Table1 AS t1 WHERE t1.reg_date = ( SELECT TOP 1 t2.reg_date FROM Table1 AS t2 WHERE t2.namee = t1.namee ORDER BY t2.reg_date DESC ) ORDER BY t1.namee;

شوفت بقى الكلام اختلف ازاى كده مش بقول لك

طيب بعد اذن اساتذتى ممكن اقول فكرتى المتواضعة اولا فى الجدول tabl2 اضف حقل جديد نوعه تاريخ واعطه الاسم TimeNow وفى القيمة الافتراضية للحقل من الجدول ضع Now() استخدام TOP 1 مع ORDER BY على حقل الوقت (Timenow) هو طريقة شائعة للعثور على أحدث سجل بناء على الزمن هذه الطريقة تعتبر فعالة وسريعة بالنسبة لاستخدام SELECT Max قد يكون ذلك فعالا ولكن قد يكون لديه بعض التأثيرات على الأداء في حالة كانت كمية السجلات كبيرة عموما الفرق في الأداء قد يكون غير ملحوظ في العديد من الحالات والاختيار بين الطريقتين يعتمد على الاحتياجات الدقيقة لتطبيقك يفضل اختيار الطريقة التي تفي بمتطلبات تطبيقك وتتناسب مع نمط البيانات الخاص بك في حالة استفادتك من TOP 1 مع ORDER BY يمكنك الاستمرار في استخدامها بثقة اخيرا الاستعلام يكون بالشكل الاتى: SELECT TOP 1 tabl2.id, tabl2.INAME, tabl2.sal_price, tabl2.Qty, tabl2.No_tawla, tabl2.sal_price * tabl2.Qty AS Price FROM tabl2 ORDER BY tabl2.TimeNow DESC;

هلا والله

كلام حضرتك من غير تفصيل انا مش قادر احد عاوز اعلى قيمة واللا تبحث بمعايير محدده ؟؟ لو اعلى قيمة استحدم الاتى فى الاستعلام SELECT Amount FROM Table1 WHERE RegDate = (SELECT Max(RegDate) FROM Table1); أو ممكن SELECT TOP 1 Amount FROM Table1 ORDER BY RegDate DESC;

طلبلك مش واضح ياريت تقول انت عاوز تعمل ايه بالضبط يعنى انت عاوز ايه بالتفصيل انت بخيل فى شرحك تتوقع تلاقى كرم فى الرد عليك ؟؟؟

بعد اذن استاذى الجليل الاستاذ @kkhalifa1960 اختنا السائلة الاستاذة @ايناس استخدمت الكود صح لكن يحتاج الى هذا التعديل فقط =Left(Replace([REGION],"<div>",""),1) & "" وهذا لان مربع النص REGION استخدمت فيه اختنا الغالية خاصية Rich Text

استاذى الجليل ومعلمى القدير و والدى الحبيب الاستاذ @ابوخليل جزاكم الله خيــــرا على دعواتكم الطيبة اسأل الله تعالى ان يرزقكم فضلها واجرها اضعافا مضاعفة لكم كل الفضل بعد رب العزة سبحانه وتعالى انضممت اليكم ولا اعلم عن الاكسس الا اسمه فجزاكم الله خيـرا على رعايتكم بحب وتحملكم بحلم شكر الله لكم انتم وكل اساتذتى الذين اتعلم منهم واخيـــــر وليس آخرا احبكم فى الله

انتظر وان شاء الله ابشـر بالخيـر

ومن قال انه يكفينى انا ؟! ومن قال اننى فى حل اعتذر عن التأخير كنت صائم بل روعة حياتنا هم اساتذتنا العظماء الذين اناروا افكارنا شكرا لكم استاذى الجليل و معلمى القدير و والدى الحبيب استاذ @ابوخليل سعادة الحياة أن تكون بجانبك وتساندك روح طيبة وكريمة تمنحك وتهديك الفرح والسرور وتدخل على نفوس من حولها الفرح و السعادة ولا أزكيكم على الله وكل اساتذتنا المبجلين كل كلمات ومعان الشكر والعرفان بالجميل لا تكفيكم وتوفيكم قدر حقكم بارك الله لكم فى عمركم وفى علمكم و عملكم واهلكم وأسال الله تعالى لكم سعادة الدارين وان يزيدكم من فضله كما تدخلون السرور على قلوب طلاب العلم دائما تكثرون من العطاء وبكل سخاء دون كلل ولا ملل احسن الله اليكم كما تحسنون الى طلاب العلم دائما ----- اتفضل استاذى الجليل ومعلمى القدير ووالدى الحبيب اولا الدالة الاتية لاحضار اسماء الحقول Function GetFieldNameFromRowSource(ComboRowSource As String, columnIndex As Integer) As String Dim columns As Variant Dim columnName As String ' Split the RowSource to get the column names columns = Split(Mid(ComboRowSource, InStr(ComboRowSource, "SELECT") + Len("SELECT")), ",") ' Extract the column name from the specified index columnName = Trim(Split(Split(columns(columnIndex - 1), "AS")(0), ".")(1)) ' Return the column name GetFieldNameFromRowSource = columnName End Function وهذه الدالة التى يتم التحديث من خلالها Sub GetComboBoxNameAndUpdateTableRecords(frm As Form) Dim ctrl As Control Dim ComboRowSource As String Dim FldData As String Dim FldID As String Dim strSQL As String ' Loop through all controls on the form For Each ctrl In frm.Controls ' Check if the control is a TextBox or a ComboBox If TypeOf ctrl Is comboBox Then ' Perform your custom action for each control ' For example, print the name and set a default value If Not ctrl Is Nothing Then ' Debug.Print "Control Name: " & ctrl.Name ComboRowSource = ctrl.rowSource FldID = GetFieldNameFromRowSource(ComboRowSource, 1) FldData = GetFieldNameFromRowSource(ComboRowSource, 2) Dim varConditionFieldValue As Variant Dim varUpdateFieldValue As Variant ' Open the database Dim db As DAO.Database Set db = CurrentDb ' Verify RowSource If Len(ComboRowSource) = 0 Then ' Debug.Print "RowSource is empty for control " & ctrl.Name Exit For End If ' Open a recordset for the values in targetComboBox Dim rsCombo As DAO.Recordset Set rsCombo = db.OpenRecordset(ComboRowSource, dbOpenSnapshot) ' Verify Recordset If rsCombo.EOF Then ' Debug.Print "Recordset is empty for control " & ctrl.Name rsCombo.Close Set rsCombo = Nothing Set db = Nothing Exit For End If Do Until rsCombo.EOF Dim TableName As String Dim FieldToUpdate As String Dim ConditionFieldNameTable As Variant Dim ConditionComboBoxFieldNameTable As Variant ' Get the value from the current record in targetComboBox varConditionFieldValue = rsCombo.Fields(FldID).Value varUpdateFieldValue = rsCombo.Fields(FldData).Value ' Table and Field Names TableName = "Table1" FieldToUpdate = "textNm" ConditionFieldNameTable = "frmNm" ConditionComboBoxFieldNameTable = "FieldNm" ' Construct the SQL update statement strSQL = "UPDATE " & TableName & " " & _ "SET " & FieldToUpdate & "='" & Nz(varUpdateFieldValue, "") & "' " & _ "WHERE " & TableName & "." & ConditionComboBoxFieldNameTable & "= '" & ctrl.Name & "' AND " & _ TableName & "." & ConditionFieldNameTable & "= '" & Nz(frm.Name, "") & "' AND " & _ TableName & "." & FieldToUpdate & "= '" & varConditionFieldValue & "';" ' Debug.Print strSQL ' Execute the query db.Execute strSQL, dbFailOnError rsCombo.MoveNext Loop ' Close the recordset and the database rsCombo.Close Set rsCombo = Nothing Set db = Nothing End If End If Next ctrl End Sub ونستدعى الدالة فقط من خلال GetComboBoxNameAndUpdateTableRecords Me هى سوف تقوم بكل شئ بالنيابة عنك لا تقلق منها يا معلملى هى دالة ذكية ليست مثلى طبعا يا استاذى الجليل ومعلمى القدير و والدى الحبيب الاستاذ @ابوخليل ان اردت اضافة هذه المعاملات ( parameters ) الى رأس الدالة لتكتبها عند الاستدعاء ان كانت متغيرة فلا بأس بذلك سبق التعامل معها فى الامثلة السابقة ' Table and Field Names TableName = "Table1" FieldToUpdate = "textNm" ConditionFieldNameTable = "frmNm" ConditionComboBoxFieldNameTable = "FieldNm" بــــــس خلاص أخيرا خلصت الواجب الحمد لله واخيرا المرفق DatabaseUp7.rar

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

استاذى الجليل ومعلمى القدير و والدلى الحبيب الاستاذ @ابوخليل اعتذر انا فى العمل الان لذلك اعتذر عن التأخير فى الرد وهذا التعديل الاخير بناء على رغباتكم اتمنى ان شاء الله أن يكون ملائما ومناسبا بصراحة مش قادر اسهل التعامل مع الدالة باستدعائها باكتر من ذلك اعرف ان كود الاستدعاء اصبح كبير جدا ويحتوى على العديد من المعاملات parameters Sub UpdateTableRecordsFromComboBox(TableName As String, _ FieldToUpdate As String, _ ConditionFieldNameTable As String, _ ConditionComboBoxFieldNameTable As String, _ frm As Form, _ TargetComboBox As ComboBox, _ ConditionFieldName As String, _ UpdateValueFieldName As String) Dim db As DAO.Database Dim strSQL As String Dim varConditionFieldValue As Variant Dim varUpdateFieldValue As Variant Dim rsCombo As DAO.Recordset ' Check if the tableName is specified If Nz(TableName, "") = "" Then MsgBox "Please specify the table name.", vbExclamation Exit Sub End If ' Check if the FieldToUpdate is specified If Nz(FieldToUpdate, "") = "" Then MsgBox "Please specify the target field name to update.", vbExclamation Exit Sub End If ' Check if the targetComboBox is valid If TargetComboBox Is Nothing Then MsgBox "Please select a valid ComboBox.", vbExclamation Exit Sub End If ' Check if the conditionFieldTable is specified If Nz(ConditionFieldNameTable, "") = "" Then MsgBox "Please specify the condition field name for the table.", vbExclamation Exit Sub End If ' Check if the conditionField is specified If Nz(ConditionFieldName, "") = "" Then MsgBox "Please specify the condition field name.", vbExclamation Exit Sub End If ' Check if the updateValueField is specified If Nz(UpdateValueFieldName, "") = "" Then MsgBox "Please specify the update field name.", vbExclamation Exit Sub End If ' Check if the ConditionComboBoxFieldNameTable is specified If Nz(ConditionComboBoxFieldNameTable, "") = "" Then MsgBox "Please specify the condition ComboBox field name for the table.", vbExclamation Exit Sub End If ' Open the database Set db = CurrentDb ' Open a recordset for the values in targetComboBox Set rsCombo = db.OpenRecordset(TargetComboBox.RowSource, dbOpenSnapshot) ' Disable the error handling temporarily On Error Resume Next ' Loop through each record in targetComboBox Do Until rsCombo.EOF ' Get the value from the current record in targetComboBox varConditionFieldValue = rsCombo.Fields(ConditionFieldName).Value varUpdateFieldValue = rsCombo.Fields(UpdateValueFieldName).Value ' Construct the SQL update statement strSQL = "UPDATE " & TableName & " " & _ "SET " & FieldToUpdate & "='" & Nz(varUpdateFieldValue, "") & "' " & _ "WHERE " & TableName & "." & ConditionComboBoxFieldNameTable & "= '" & TargetComboBox.Name & "' AND " & _ TableName & "." & ConditionFieldNameTable & "= '" & Nz(frm.Name, "") & "' AND " & _ TableName & "." & FieldToUpdate & "= '" & varConditionFieldValue & "';" ' Debugging information ' Dbug.Print "SQL Statement: " & strSQL ' Execute the query db.Execute strSQL ' Check for errors If Err.Number <> 0 Then ' Clear the error Err.Clear ' Move to the next record without processing the error Resume Next End If ' Move to the next record in targetComboBox rsCombo.MoveNext Loop ' Enable the normal error handling On Error GoTo 0 ' Close the recordset and the database rsCombo.Close Set rsCombo = Nothing Set db = Nothing strSQL = vbNullString varConditionFieldValue = vbNullString varUpdateFieldValue = vbNullString End Sub المرفق.. DatabaseUp6.rar

استاذى الجليل ومعلمى القدير و والدى الحبيب الاستاذ @ابوخليل فى المشاركة السابقة كان الروتين لابد من تمرير له -مربع السرد مصدر البيانات -اسم حقل الشرط -اسم الحقل الذى يحوى القيم المراد التحديث مثلها --------------------------------------------------------------------------------------- فى هذاالتعديل اضفت اسم الجدول واسم الحقل المراد تحديثه كذلك ليكون الروتين عام بذلك لن نحتاج الى تعديل اى شئ فى بناء الكود مستقبلا مهما اختلفت الاسماء للجداول والحقول بذلك يكون متاح لحضرتك كل الافكار فتدلل واختر منها ما يتماشى مع رغباتك ويلائم احتياجاتك وافكارك تحديث جديد لتمرير اسم الجدول كذلك للروتين على ان يكون الاستدعاء UpdateTableRecordsFromComboBox "Table1", "text1", Me.Combo0, "id", "sName" Sub UpdateTableRecordsFromComboBox(TableName As String, _ FieldToUpdate As String, _ TargetComboBox As ComboBox, _ ConditionFieldName As String, _ UpdateValueFieldName As String) Dim db As DAO.Database Dim strSQL As String Dim intConditionFieldValue As Integer Dim strUpdateFieldValue As String Dim rsCombo As DAO.Recordset ' Check if the tableName is specified If Nz(TableName, "") = "" Then MsgBox "Please specify the table name.", vbExclamation: Exit Sub ' Check if the FieldToUpdate is specified If Nz(FieldToUpdate, "") = "" Then MsgBox "Please specify the target field name to update.", vbExclamation: Exit Sub ' Check if the targetComboBox is valid If TargetComboBox Is Nothing Then MsgBox "Please select a valid ComboBox.": Exit Sub ' Check if the conditionField is specified If Nz(ConditionFieldName, "") = "Please specify the condition field name." Then MsgBox "": Exit Sub ' Check if the updateValueField is specified If Nz(UpdateValueFieldName, "") = "" Then MsgBox "Please specify the update field name.": Exit Sub ' Open the database Set db = CurrentDb ' Open a recordset for the values in targetComboBox Set rsCombo = db.OpenRecordset(TargetComboBox.RowSource, dbOpenSnapshot) ' Disable the error handling temporarily On Error Resume Next ' Loop through each record in targetComboBox Do Until rsCombo.EOF ' Get the value from the current record in targetComboBox intConditionFieldValue = rsCombo.Fields(ConditionFieldName).Value strUpdateFieldValue = rsCombo.Fields(UpdateValueFieldName).Value ' Construct the SQL update statement strSQL = "UPDATE " & TableName & " " & _ "SET " & FieldToUpdate & "= '" & Nz(strUpdateFieldValue, "") & "' " & _ "WHERE " & TableName & "." & FieldToUpdate & "= '" & intConditionFieldValue & "';" ' Execute the query db.Execute strSQL ' Check for errors If Err.Number <> 0 Then ' Clear the error Err.Clear ' Move to the next record without processing the error Resume Next End If ' Move to the next record in targetComboBox rsCombo.MoveNext Loop ' Enable the normal error handling On Error GoTo 0 ' Close the recordset and the database rsCombo.Close Set rsCombo = Nothing Set db = Nothing End Sub DatabaseUp4.rar

اتفضل استاذى الجليل ومعلمى القدير و والدى الحبيب Sub UpdateTableRecordsFromComboBox(targetComboBox As ComboBox, conditionField As String, updateField As String) Dim db As DAO.Database Dim strSQL As String Dim intconditionFieldValue As Integer Dim strupdateFieldValue As String Dim rsCombo As DAO.Recordset If targetComboBox Is Nothing Then MsgBox "Please select a valid ComboBox.": Exit Sub If Nz(conditionField, "") = "Please specify the condition field name." Then MsgBox "": Exit Sub If Nz(updateField, "") = "" Then MsgBox "Please specify the update field name.": Exit Sub ' Open the database Set db = CurrentDb ' Open a recordset for the values in targetComboBox Set rsCombo = db.OpenRecordset(targetComboBox.RowSource, dbOpenSnapshot) ' Disable the error handling temporarily On Error Resume Next ' Loop through each record in targetComboBox Do Until rsCombo.EOF ' Get the value from the current record in targetComboBox intconditionFieldValue = rsCombo.Fields(conditionField).Value strupdateFieldValue = rsCombo.Fields(updateField).Value ' Construct the SQL update statement strSQL = "UPDATE Table1 " & _ "SET text1 = '" & Nz(strupdateFieldValue, "") & "' " & _ "WHERE Table1.text1 = '" & intconditionFieldValue & "';" ' Execute the query db.Execute strSQL ' Check for errors If Err.Number <> 0 Then ' Clear the error Err.Clear ' Move to the next record without processing the error Resume Next End If ' Move to the next record in targetComboBox rsCombo.MoveNext Loop ' Enable the normal error handling On Error GoTo 0 ' Close the recordset and the database rsCombo.Close Set rsCombo = Nothing Set db = Nothing End Sub وللاستدعاء UpdateTableRecordsFromComboBox Me.Combo0, "id", "sName" DatabaseUp3.rar

وكذلك اسم اسم حقل الشرط واسم حقل القيمة

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

العفو منكم استاذى الجليل ومعلمى القدير طيب ممكن نعمل الكود الثانى بالشكل الاتى ليتم التحديث على الجميع جملة مرة واحدة وبدون اختيار اى قيمة من مربع التحرير ولكن سوف يكون ذلك التحديث بالاعتماد على القيم من مربع السرد مهما كان مصدر بياناته Dim db As DAO.Database Dim strSQL As String Dim intcomboValue As Integer Dim strcomboValue As String Dim rsCombo As DAO.Recordset ' Open the database Set db = CurrentDb ' Open a recordset for the values in Combo0 Set rsCombo = db.OpenRecordset(Me.Combo0.RowSource, dbOpenSnapshot) ' Disable the error handling temporarily On Error Resume Next ' Loop through each record in Combo0 Do Until rsCombo.EOF ' Get the value from the current record in Combo0 intcomboValue = rsCombo.Fields("id").Value strcomboValue = rsCombo.Fields("sName").Value ' Construct the SQL update statement strSQL = "UPDATE Table1 " & _ "SET text1 = '" & Nz(strcomboValue, "") & "' " & _ "WHERE Table1.text1 = '" & intcomboValue & "';" ' Execute the query db.Execute strSQL ' Check for errors If Err.Number <> 0 Then ' Clear the error Err.Clear ' Move to the next record without processing the error Resume Next End If ' Move to the next record in Combo0 rsCombo.MoveNext Loop ' Enable the normal error handling On Error GoTo 0 ' Close the recordset and the database rsCombo.Close Set rsCombo = Nothing Set db = Nothing الان الاعتماد على مربع السرد مهما كان مصدر بياناته من خلال السطر Set rsCombo = db.OpenRecordset(Me.Combo0.RowSource, dbOpenSnapshot)

ههههههههه استاذى الجليل @Barna بما انك تضحك اضخك الله سنك يبقى شكلى خربط الدنيا ع الاخر

وبعد ان انتبهت لهذه النقطة هذه فكرتى Dim db As DAO.Database Dim strSQL As String Dim intcomboValue As Integer Dim strcomboValue As String Dim rsCombo As DAO.Recordset ' Open the database Set db = CurrentDb ' Open a recordset for the values in Combo0 Set rsCombo = db.OpenRecordset("SELECT tblSp.id, tblSp.sName, * FROM tblSp;", dbOpenSnapshot) ' Disable the error handling temporarily On Error Resume Next ' Loop through each record in Combo0 Do Until rsCombo.EOF ' Get the value from the current record in Combo0 intcomboValue = rsCombo.Fields("id").Value strcomboValue = rsCombo.Fields("sName").Value ' Construct the SQL update statement strSQL = "UPDATE Table1 " & _ "SET text1 = '" & Nz(strcomboValue, "") & "' " & _ "WHERE Table1.text1 = '" & intcomboValue & "';" ' Execute the query db.Execute strSQL ' Check for errors If Err.Number <> 0 Then ' Clear the error Err.Clear ' Move to the next record without processing the error Resume Next End If ' Move to the next record in Combo0 rsCombo.MoveNext Loop ' Enable the normal error handling On Error GoTo 0 ' Close the recordset and the database rsCombo.Close Set rsCombo = Nothing Set db = Nothing انا اعتبرت مربع السرد غير موجود على النموذج اصلا ووضعت مصدر البيانات فى الكود بديلا عنه Set rsCombo = db.OpenRecordset("SELECT tblSp.id, tblSp.sName, * FROM tblSp;", dbOpenSnapshot) مش عارف ده صح واللا غلط او بالاخص مش عارف انا فاهم واللا مش فاهم انت عارف فهمى على اد حالى ثغنون DatabaseUp2.rar

وعليكم السلام ورحمة الله تعالى وبركاته هل يفى ذلك بالغرض استاذى الجليل ومعلمى القدير و والدى الحبيب Dim db As DAO.Database Dim strSQL As String Dim newValue As String Dim IDValue As Integer ' Open the database Set db = CurrentDb ' Get the text and numeric value from the combo box newValue = Me.Combo0.Column(1) IDValue = Me.Combo0.Value ' Check for the existence of a value before inserting it into the query If Not IsNull(newValue) Then ' Update the table using the text value strSQL = "UPDATE Table1 " & _ "SET text1 = '" & Nz(newValue, "") & "' " & _ "WHERE Table1.text1 = '" & IDValue & "';" ' Execute the query db.Execute strSQL Else ' Notification or other action if no value is found MsgBox "No matching value found in tblSp.", vbExclamation End If ' Close the database Set db = Nothing

بشراكم الجنة ان شاء الله رفع الله قدركم واعلى شأنكم حفظكم الله تعالى وبارك لكم فى عمركم وعلمكم وعملكم واهلكم وولدكم

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

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

يمكن عمل ذلك من خلال استخدام الربط المتأخر (Late Binding) أو الربط المتقدم (Early Binding) وهذا يعتمد على الاحتياجات الخاصة بالتطبيق الذي تقوم بتطويره وعلى الاعتبارات التي ترغب في مراعاتها الربط المتأخر (Late Binding): المرونة: يوفر المزيد من المرونة في حال تحتاج إلى تشغيل التطبيق على إصدارات مختلفة من تطبيق Microsoft Office دون الحاجة إلى إعادة كتابة الشيفرة لا يتطلب تحديد مراجع (References) محددة والتى تختلف تبعا لاختلاف اصدار الأكسس التوافق: يسمح بالتوافق مع تطبيقات Office على أنظمة التشغيل المختلفة بشكل أفضل التحقق من وجود الكائنات: يتطلب التحقق اليدوي من وجود الكائنات أو استخدام الكائنات بدون تحقق مسبق الربط المتقدم (Early Binding): الأداء: قد يكون الربط المتقدم أسرع من الربط المتأخر لأنه يتم تحديد الكائنات في وقت التصميم وليس في وقت التشغيل التحقق التلقائي: يتيح لك IntelliSense والتحقق التلقائي في وقت الكتابة، مما يسهل استكشاف واستخدام الكائنات المتاحة الوثائق والدعم: يوفر تحديد مراجع VBA معلومات وثائق أفضل ودعمًا تلقائيًا للأوامر والخصائص الختام: إذا كنت بحاجة إلى أقصى قدر من المرونة والتوافق وليس لديك اهتمام بالتحقق التلقائي والأداء الأقصي يمكنك استخدام الربط المتأخر إذا كان الأداء والتحقق التلقائي والوثائق المفصلة هي الأمور الرئيسية قطعا سوف تفضل استخدام الربط المتقدم عند استخدام الربط المتقدم يجب أن تأخذ في اعتبارك أن توفر ملفات التعريف (المراجع) قد تتغير مع إصدارات مختلفة من تطبيقات Office لذا يجب عليك تحديثها بناءً على الإصدار الذي يتم استخدامه طيب بالنسبة لى سوف افضل الربط المتقدم (Early Binding) اسباب التفضيل : يهمنى الأداء والمرونة والسرعة وان شاء الله اقدم لكم افكار عبقرية تقدم الاستفادة القصوى دون اى عناء فى المستقبل حيث تمكنت من معالجة السلبيات ان وجدت وهى كالاتى المكتبات - تم علاج مشكلة المكتبات فى هذا الموضوع : library reference: حفظ واسترجاع المكتبات المستخدمة( وداعا لفقد المكتبات بعد اليوم ) - علاج مشكلة اعادة كتابة الاكواد مرارا وتكرارا باستخدام موديول ذكى ولماح وشاطر طيب اولا اسم الموديول : basFileUtilityKit المرجع الذى يجب التأكد من اضافته : Microsoft Office 16.0 Object Library طبعا الرقم 16.0 قد يكون 14.0 أو ....... الخ يختلف تبعا لاصدار الاكسس تم استخدام Enumerated لاضفاء المرونة هو نوع بيانات يتكون من مجموعة من القيم المسماة تسمى العناصر أو الأعضاء أو التعداد أو التعداد من النوع أسماء العداد عادة ما تكون معرفات تتصرف كثوابت في لغة البرمجه يمكن أن يُنظر إلى النوع الذي تم تعداده باعتباره اتحادًا مميزًا من نوع الوحدة الدوال داخل الموديول كالاتى ' Enumeration for the types of file dialogs Enum EnumFileDialogType msoFileDialogFilePicker = 1 msoFileDialogFolderPicker = 4 End Enum ' Enumeration for different file extensions Enum EnumFileExtensions AllFiles TextFiles ExcelFiles ImageFiles VideoFiles AudioFiles PDFFiles WordFiles ' You can add additional file extensions as needed here End Enum ' Enumeration for different options related to file paths Enum EnumOptionFile FilePathWithFileName = 1 FilePathWithoutFileName = 2 FileNameWithExtension = 3 FileNameWithoutExtension = 4 FileExtensionOnly = 5 End Enum Public ChosenFilePaths() As String Dim TempChosenFilePaths() As String ' Check if the Microsoft Office Object Library is referenced ' Make sure to go to Tools > References and select the appropriate version ' e.g., "Microsoft Office 16.0 Object Library" for Office 2016 ' Function to open the file dialog and return the selected file paths Function GetFileDialog(Optional ByVal EnumFileExtension As EnumFileExtensions = AllFiles, Optional ByVal AllowMultipleFiles As Boolean = False) As Variant Dim i As Integer Dim fileDialogObject As Object Dim FilePaths() As String ' Use TempChosenFilePaths as a temporary storage ReDim TempChosenFilePaths(1 To 1) Set fileDialogObject = Application.FileDialog(EnumFileDialogType.msoFileDialogFilePicker) With fileDialogObject .Title = "Select File" .AllowMultiSelect = AllowMultipleFiles .Filters.Clear ' Adding filters based on the selected file extension Select Case EnumFileExtension Case EnumFileExtensions.AllFiles .Filters.Add "All Files", "*.*" Case EnumFileExtensions.TextFiles .Filters.Add "Text Files", "*.txt" Case EnumFileExtensions.ExcelFiles .Filters.Add "Excel Files", "*.xlsx; *.xls" Case EnumFileExtensions.ImageFiles .Filters.Add "Image Files", "*.jpg; *.jpeg; *.png; *.gif" Case EnumFileExtensions.VideoFiles .Filters.Add "Video Files", "*.mp4; *.avi; *.mov" Case EnumFileExtensions.AudioFiles .Filters.Add "Audio Files", "*.mp3; *.wav; *.ogg" Case EnumFileExtensions.PDFFiles .Filters.Add "PDF Files", "*.pdf" Case EnumFileExtensions.WordFiles .Filters.Add "Word Files", "*.docx; *.doc" ' You can add additional file extensions as needed here End Select If .Show = -1 Then ' ReDim the array to the number of selected items ReDim FilePaths(1 To .SelectedItems.Count) ' Populate the array with selected item paths For i = 1 To .SelectedItems.Count FilePaths(i) = .SelectedItems(i) ' Add to TempChosenFilePaths TempChosenFilePaths(UBound(TempChosenFilePaths)) = FilePaths(i) ReDim Preserve TempChosenFilePaths(1 To UBound(TempChosenFilePaths) + 1) Next i ' Return the array GetFileDialog = JoinFilePaths(FilePaths) ' Update ChosenFilePaths with the temporary values ChosenFilePaths = TempChosenFilePaths ' Clear TempChosenFilePaths Erase TempChosenFilePaths Else ' Return an empty string if no file is selected GetFileDialog = "" End If End With ' Set file dialog object to nothing Set fileDialogObject = Nothing End Function ' Function to join paths and set them to the global variable Function JoinFilePaths(paths() As String) As String JoinFilePaths = Join(paths, vbCrLf) End Function ' Function to check if ListBox contains a specific item Function ListBoxContainsItem(listBox As Object, item As String) As Boolean Dim i As Integer ListBoxContainsItem = False For i = 0 To listBox.ListCount - 1 If listBox.Column(0, i) = item Then ListBoxContainsItem = True Exit Function End If Next i End Function ' Subroutine to add paths to ListBox in the form Sub AddToFormListBox(frm As Object, paths() As String, ListBoxName As String, Optional ClearListBox As Boolean = True) Dim i As Integer Dim listBoxControl As Object ' Check if frm is not Nothing If Not frm Is Nothing Then ' Check if ListBox with the specified name exists in the form's controls On Error Resume Next Set listBoxControl = frm.Controls(ListBoxName) On Error GoTo 0 ' If ListBox control exists, add or clear items If Not listBoxControl Is Nothing Then ' Clear ListBox if ClearListBox is True If ClearListBox Then listBoxControl.RowSource = "" End If ' Add unique non-empty items to ListBox For i = LBound(paths) To UBound(paths) If Trim(paths(i)) <> "" And Not ListBoxContainsItem(listBoxControl, paths(i)) Then listBoxControl.AddItem paths(i) End If Next i Else ' Handle the case where ListBox control does not exist MsgBox "ListBox with name '" & ListBoxName & "' not found in the form.", vbExclamation End If End If End Sub ' Subroutine to add paths to Access table Sub AddToAccessTable(tableName As String, paths() As String) Dim db As DAO.Database Dim rs As DAO.Recordset Dim i As Integer Dim filePath As String ' Open the database Set db = CurrentDb ' Open the table Set rs = db.OpenRecordset(tableName, dbOpenDynaset) ' Add each non-empty and non-duplicate path to the table For i = LBound(paths) To UBound(paths) filePath = Trim(paths(i)) ' Check if the path does not already exist in the table If filePath <> "" And DCount("*", tableName, "FilePath='" & filePath & "'") = 0 Then rs.AddNew rs.Fields("FilePath").Value = filePath rs.Update End If Next i ' Close the recordset and database rs.Close Set rs = Nothing Set db = Nothing End Sub ' Function to open the folder dialog and return the selected folder path Function GetFolderDialog() As String Dim folderDialogObject As Object Set folderDialogObject = Application.FileDialog(EnumFileDialogType.msoFileDialogFolderPicker) With folderDialogObject .Title = "Select Folder" .AllowMultiSelect = False .Show End With If folderDialogObject.SelectedItems.Count > 0 Then GetFolderDialog = folderDialogObject.SelectedItems(1) Else ' Handle the case where no folder is selected MsgBox "No folder selected.", vbExclamation GetFolderDialog = "" End If Set folderDialogObject = Nothing End Function ' Function to get the desired option for a file path Function GetFileOption(ByRef filePath As String, Optional ByRef EnumOptionFile As EnumOptionFile = FilePathWithFileName) As String ' Check if the file exists If FileExists(filePath) Then ' Get file File Option using GetFileOption function Select Case EnumOptionFile Case FilePathWithoutFileName GetFileOption = Left(filePath, InStrRev(filePath, "\")) Case FilePathWithFileName GetFileOption = filePath Case FileNameWithExtension GetFileOption = Mid(filePath, InStrRev(filePath, "\") + 1) Case FileExtensionOnly GetFileOption = Right(filePath, Len(filePath) - InStrRev(filePath, ".")) Case FileNameWithoutExtension GetFileOption = Mid(filePath, InStrRev(filePath, "\") + 1, InStrRev(filePath, ".") - InStrRev(filePath, "\") - 1) End Select Else ' Return an empty string if the file does not exist GetFileOption = "" End If End Function ' Function to get additional information about a file Function GetFileInfo(filePath As String) As String ' Check if the file exists If FileExists(filePath) Then ' Get file information using GetFileInfo function Dim fileInfo As String fileInfo = "File Information:" & vbCrLf fileInfo = fileInfo & "Path: " & filePath & vbCrLf fileInfo = fileInfo & "Size: " & FileLen(filePath) & " bytes" & vbCrLf fileInfo = fileInfo & "Created: " & FileDateTime(filePath) & vbCrLf GetFileInfo = fileInfo Else ' Return an empty string if the file does not exist GetFileInfo = "" End If End Function ' Function to create a new folder Function CreateNewFolder(parentPath As String, folderName As String) As String Dim newFolderPath As String newFolderPath = parentPath & "\" & folderName MkDir newFolderPath CreateNewFolder = newFolderPath End Function ' Function to check if a file exists Function FileExists(ByVal filePath As String, Optional findFolders As Boolean = False) As Boolean Const vbReadOnly As Long = 1 Const vbHidden As Long = 2 Const vbSystem As Long = 4 Const vbDirectory As Long = 16 Dim attributes As Long attributes = (vbReadOnly Or vbHidden Or vbSystem) If findFolders Then attributes = (attributes Or vbDirectory) ' Include folders as well. Else ' Strip any trailing slash, so Dir does not look inside the folder. Do While Right(filePath, 1) = "\" filePath = Left(filePath, Len(filePath) - 1) Loop End If ' If Dir() returns something, the file exists. FileExists = (Len(Dir(filePath, attributes)) > 0) End Function من خلال تلك الوحدة النمطية يمكن عمل الاتى 1- انتقاء مسار مجلد من خلال الدالة : GetFolderDialog الاستدعاء: GetFolderDialog 2- انتقاء مسار ملف / ملفات من خلال الدالة : GetFileDialog الاستدعاء:GetFileDialog(EnumFileExtensions, AllowMultipleFiles) -قائمة EnumFileExtensions التى تضفى مرونة فى تحديد نوع الملفات التى تريد انتقائها - AllowMultipleFiles تحديد ما اذا كنت تريد انتقاء ملف واحد فقط لتكون False , أو ملفات متعددة لتكون True 3-استخلاص معلومات الملف من خلال الدالة : GetFileInfo الاستدعاء:GetFileInfo(filePath) 4- التحكم فى خيارات الملف / الملفات من خلال الدالة : GetFileOption وهى (المسار كاملا مع اسم الملف , مسار الملف فقط , اسم الملف مع الامتداد فقط , امتداد الملف فقط ) الاستدعاء:GetFileOption(filePath , EnumOptionFile) 5- اضافة مسار الملف / الملفات الذى يتم انتقاءه كاملا او حسب ما تريد من الخطوة الرابعة السابقة الى مربع قائمة وذلك من خلال الدالة : AddToFormListBox الاستدعاء: 6- اضافة مسار الملف / الملفات الذى يتم انتقاءه كاملا او حسب ما تريد من الخطوة الرابعة الى جدول من خلال الدالة: AddToAccessTable الاستدعاء: يتبع...... FileDialog.accdb

السلام عليكم ورحمة الله تعالى وبركاته انا بصدد تصميم قاعدة بيانات فى عملى وتباعا ان شاء الله اضع بين اياديكم خلاصة مجهود وتعليم سنوات اولا تسجيل الاخطاء ومعالجتها اولا موديول باسم : basErrorHandling Public strProcessName As String ' The name of the table where errors are logged Public Const TABLE_ERROR_LOG_NAME As String = "tblErrorLog" ' Subroutine to log errors in the error log table Sub ErrorLog(ByVal intErrorNumber As Integer, ByVal strErrorDescription As String, ByVal strErrorProcessName As String) On Error GoTo Err_ErrorLog Dim strErrorMsg As String strErrorMsg = "Error " & intErrorNumber & ": " & strErrorDescription ' Show a message to the user MsgBox strErrorMsg, vbQuestion, strErrorProcessName ' Log error details in the error log table With CurrentDb.OpenRecordset(TABLE_ERROR_LOG_NAME) .AddNew ![ErrorNumber] = intErrorNumber ![ErrorDescription] = Left$(strErrorDescription, 255) ![ErrorProcessName] = strErrorProcessName ![ErrorDate] = Now() ![userName] = GetLoggedUserName() .Update .Close End With Exit_ErrorLog: Exit Sub Err_ErrorLog: ' Error message in case of an unexpected issue strErrorMsg = "An unexpected situation arose in your program." & vbNewLine strErrorMsg = strErrorMsg & "Please write down the following details:" & vbNewLine & vbNewLine strErrorMsg = strErrorMsg & "Calling Proc: " & strErrorProcessName & vbNewLine strErrorMsg = strErrorMsg & "Error Number " & intErrorNumber & vbNewLine & strErrorDescription & vbNewLine & vbNewLine strErrorMsg = strErrorMsg & "Unable to record because Error " & Err.Number & vbNewLine & Err.Description & vbNewLine strErrorMsg = strErrorMsg & "Occurred at Line: " & Erl MsgBox strErrorMsg, vbCritical, "ErrorLog()" Resume Exit_ErrorLog End Sub ' Subroutine to handle and log errors ' This subroutine checks for errors and logs them using the ErrorLog function. ' It clears the error after logging it. ' Parameters: ' - strProcName: The name of the procedure where the error occurred. Public Sub HandleAndLogError(ByVal strProcName As String) ' Check for errors If Err.Number <> 0 Then ' Handle the error and log it Call ErrorLog(Err.Number, Err.Description, strProcName) ' Clear the error Err.Clear End If End Sub ' Function to get the logged username, or return "N/A" if not available Function GetLoggedUserName() As String On Error Resume Next Dim userName As String userName = Environ("USERNAME") If Err.Number <> 0 Then userName = "N/A" Err.Clear End If On Error GoTo 0 GetLoggedUserName = userName End Function ---------------------------------------------------------------------- ثانيا مويدول باسم : basInitialization ' The name of the table where errors are logged Public Const TABLE_ERROR_LOG_NAME As String = "tblErrorLog" ' Subroutine to initialize the application Sub InitializeApplication() ' Initialize the error log table if it doesn't exist If Not IsErrorLogTableInitialized() Then CreateErrorLogTable End Sub ' Check if the error log table exists and is initialized Function IsErrorLogTableInitialized() As Boolean Dim db As DAO.Database Dim rs As DAO.Recordset ' Use error handling to check if the error log table exists On Error Resume Next Set db = CurrentDb Set rs = db.OpenRecordset(TABLE_ERROR_LOG_NAME) On Error GoTo 0 ' Check if the error log table is initialized (contains necessary fields) If Not rs Is Nothing Then On Error Resume Next rs.MoveFirst IsErrorLogTableInitialized = (Err.Number = 0) And (rs.Fields.Count >= 6) On Error GoTo 0 rs.Close End If Set rs = Nothing Set db = Nothing End Function ' Subroutine to create the error log table Sub CreateErrorLogTable() On Error Resume Next Dim db As DAO.Database Set db = CurrentDb ' Check if the table already exists If Not IsTableExists(TABLE_ERROR_LOG_NAME, db) Then ' Define the SQL code to create the table Dim strSQL As String strSQL = "CREATE TABLE " & TABLE_ERROR_LOG_NAME & " (" & _ "ID AUTOINCREMENT PRIMARY KEY, " & _ "ErrorProcessName TEXT(255), " & _ "ErrorNumber LONG, " & _ "ErrorDescription MEMO, " & _ "ErrorDate DATETIME, " & _ "UserName TEXT(255));" ' Execute the SQL command to create the table directly DoCmd.RunSQL strSQL End If Set db = Nothing On Error GoTo 0 End Sub ' Function to check if a table exists in the database Function IsTableExists(tableName As String, Optional db As DAO.Database) As Boolean ' Use DLookup to check for the existence of the table in MSysObjects On Error Resume Next Set db = IIf(db Is Nothing, CurrentDb, db) IsTableExists = Not IsNull(DLookup("Name", "MSysObjects", "Name='" & tableName & "'")) On Error GoTo 0 End Function وظيفة الموديول هو تهئة ما اريد لقاعدة البيانات البدء به ومن خلاله ---------------------------------------------------------------------- 3- نموذج البداية وليكن الان باسم frmInitialization وفى حدث عند التحميل نضع الكود الاتى Private Sub Form_Load() strProcessName = "Form Load : frmIntialization" On Error Resume Next ' Initialize the application when the startup form is loaded. InitializeApplication ' Add calls to the initialized special functions through which you want the database to be booted ' Or add specify the codes through which you would like to process the data later according to the requirements of your design ' Set the current procedure name (you can adjust the procedure name as needed) If Err.Number <> 0 Then ' Handle the error (display a message) Call ErrorLog(Err, Error$, strProcessName) ' Clear the error Err.Clear End If End Sub النتيجة المرغوب فى الخصول عليها : عند تشغيل القاعدة فى المرة الأولى تنشئ جدول تسجيل الأخطاء من تلقاء نفسها باسم الروتين او الحدث ورقم الخطاء والوصف المتطلبات عند اعداد الاكواد تباعا نمرر اسم الروتين من خلال المتغير strProcessName كما فعلت فى الحدث السابق للنموذج: strProcessName = "Form Load : frmIntialization" لو حدث اى خطأ مستقبلا سوف يتم تسجيله حتى يستطيع مطور النظم او القائم على اعمال صيانة قواعد البيانات او المصمم معرفة مكان حدوث الخطأ الشق الثانى نقوم بعمل الايقاف للاخطا ليستكمل الكود عمله حتى لو وجودت اى اخطاء من خلال : On Error Resume Next بعد كتابة الكود كما نريد وبعد ان ننتهى منه نضع الشرط التالى : If Err.Number <> 0 Then بذلك نضع شرط عند الدوران على الكود لتنفيذه فى حالة وجود خطأ اولا اظهر رسالة الخطأ حتى يعلم المستخدم سبب المشكلة ثم استدعى الدالة لتسجيل هذا الخطأ ويتم ذلك من خلال Call ErrorLog(Err, Error$, strProcessName) الان هذه بداية احترافية وعلى اسس صحيحة ومفيدة للمستقبل ..... يتبع HandleAndLogError.accdb