ابو ياسين المشولي

استاذي ابو خليل ممكن تشرح الكود للفائده بارك الله فيك Dim i As Boolean On Error Resume Next i = DLookup("Tarkam", "HRR", "Rajmsanf='" & Me.Rajmsanf & "'") If i = False Then Exit Sub Else hrk_B = Nz(DMax("Atarih", "HRR", "Nwaha='13'"), 0) hrk_sh = Nz(DMax("Atarih", "HRR", "Nwaha='11'"), 0) End If من فين اخذت كلمه Tarkam

طيب كيف اعدل الكود

استاذي الفاضل القاعده هي نفسها فقط هي منقسمه وعاملها في مجلد ومرتبطه D:\بـرنـامـج الـخـيـاط\data\data.mdb"

اتمنى من استاذنا القدير ابو خليل يشوف لي حل في هذا الخطاء او الاخ جعفر

فهمتك يا صديقي الان DoCmd.RunSQL "UPDATE حركات SET حركات.البيان = Format([Forms].[Search]![snddate],""""""دخل يوم """"dddd ""), حركات.[نوع السند] = "" دخـل"",.حركات = ""الخزينه"" " & vbCrLf & _ "WHERE (((حركات.[تاريخ الحركة])=[Forms].[Search]![snddate]));" كذا ممتاز استاذي كيف اجعل لهذا الكود شرط اذا كان نفس الاسم لايتكرر شوف الصورة

وعليكم السلام انا استخدمت هذا اخي جعفر DoCmd.RunSQL "UPDATE حركات SET حركات.البيان = Format([Forms].[Search]![snddate],""""""دخل يوم """"dddd ""), حركات.[نوع السند] = ""دخـل"", حركات.الاسم = ""الخزينه"" " & vbCrLf & _ "WHERE (((حركات.[تاريخ الحركة])=[Forms].[Search]![snddate]));"

الحمدلله تم الحل وهكما يلي DoCmd.RunSQL "UPDATE حركات SET حركات.البيان = Format([Forms].[Search]![snddate],""""""دخل يوم """"dddd ""), حركات.[نوع السند] = "" دخـل"",.حركات = ""الخزينه"" " & vbCrLf & _ "WHERE (((حركات.[تاريخ الحركة])=[Forms].[Search]![snddate]));"

السلام عليكم ورحمه الله وبركاته عندي مشكله بصيغه كود ثحديث UPDATE حركات SET حركات.البيان = Format([Forms].[Search]![snddate],"""دخل يوم ""dddd "), حركات.[نوع السند] = "دخـل", حركات.الاسم = "الخزينه" WHERE (((حركات.[تاريخ الحركة])=[Forms].[Search]![snddate])); كيف يكون صحيح

هذا ما اريد لكن ماقدرت اطبقه عندي نفس الكود من اول ويطلع نعي نفس الخطاء لو تتكرم وتشرح لي الكود انا بحاول افهم اين الخطاء

تسلم ماقصرت الله يحفظك

للاسف اخي alwazeer ليس هذا ما اريد

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

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

لا استاذي هي منقسمه بس اللي رفعته انا مجرد مثال كي لا تعمل ربط ولكنك قسمت القاعده وعملت ربط على العموم انا وجد كود ولكن ماعرفت اتعامل معه هو هذا Dim strSQL As String Dim tdf As TableDef For Each tdf In CurrentDb.TableDefs If Not (Left(tdf.name, 4)) = "MSys" Then CurrentDb.Execute ("delete * from " & tdf.name) strSQL = "INSERT INTO " & tdf.name & " SELECT " & tdf.name & ".* FROM " & tdf.name & " IN '" & myfile & "';" CurrentDb.Execute (strSQL) End If Next tdf End If MsgBox "Êã ÇÓÊÑÏÇÏ ÇáäÓÎÉ ÇáÇÍÊíÇØíÉ ÈäÌÇÍ", vbInformation وهذا كان المدويل Option Compare Database Public Function ExportNew(myfile As String) ' ÅäÔÇÁ ãáÝ ÌÏíÏ Dim wrkDefault As Workspace Dim dbsNew As Database Dim mydb On Error GoTo gv mydb = Dir(myfile) If mydb = "" Then Set wrkDefault = DBEngine.Workspaces(0) Set dbsNew = wrkDefault.CreateDatabase(myfile, dbLangArabic) Call exportTbl(myfile) GoTo gv1 Else Call exportTbl(myfile) GoTo gv1 End If gv: Resume gv1: End Function Public Function exportTbl(myfile As String) 'ÊÕÏíÑ äÓÎÉ áÌãíÚ ÇáÌÏÇæá ÇáãæÌæÏÉ' Dim tdfCurr As TableDef Dim strBackupDatabase As String strBackupDatabase = myfile For Each tdfCurr In CurrentDb().TableDefs If (tdfCurr.Attributes And dbSystemObject) = 0 Then DoCmd.TransferDatabase acExport, "Microsoft Access", _ strBackupDatabase, acTable, tdfCurr.name, _ tdfCurr.name End If Next tdfCurr End Function Function ExportRelations(DbName, DbName2 As String) As Integer 'ÇáÍÇÞ ÇáÚáÇÞÇÊ ÈÇáÌÏÇæá ÇáãäÓæÎÉ Dim ThisDb As DAO.Database, ThatDB As DAO.Database Dim ThisRel As DAO.Relation, ThatRel As DAO.Relation Dim ThisField As DAO.Field, ThatField As DAO.Field Dim Cr As String, I As Integer, cnt As Integer, RCount As Integer Dim j As Integer Dim ErrBadField As Integer Cr$ = Chr$(13) RCount = 0 Set ThisDb = DBEngine.Workspaces(0).OpenDatabase(DbName2) Set ThatDB = DBEngine.Workspaces(0).OpenDatabase(DbName) For I = 0 To ThatDB.Relations.Count - 1 Set ThatRel = ThatDB.Relations(I) Set ThisRel = ThisDb.CreateRelation(ThatRel.name, _ ThatRel.Table, ThatRel.ForeignTable, ThatRel.Attributes) ErrBadField = False For j = 0 To ThatRel.Fields.Count - 1 Set ThatField = ThatRel.Fields(j) Set ThisField = ThisRel.CreateField(ThatField.name) ThisField.ForeignName = ThatField.ForeignName On Error Resume Next ThisRel.Fields.Append ThisField If Err <> False Then ErrBadField = True On Error GoTo 0 Next j If ErrBadField = True Then Else On Error Resume Next ThisDb.Relations.Append ThisRel If Err <> False Then Else RCount = RCount + 1 End If On Error GoTo 0 End If Next I ThisDb.Close ThatDB.Close ExportRelations = RCount End Function

نعم استاذي انا جعلته يقلع من tdf.Connect = ";DATABASE=" & "D:\بـرنـامـج الـخـيـاط لاني لا اريد تغير مسار القاعدة نهئيا

للاسف استاذي ابو خليل كلذا انا مسويه انا اريد استبدال الجداول وليس اعاده ربط شوف مافرقت بينك وبيني انا من اول وانا قلت اني جاعل الاقلاع من القاعده في الدي هذا عند الاقلاع On Error GoTo alalal Call SysCmd(acSysCmdSetStatus, "Re-linking the data tables...") Set db = CurrentDb() For Each tdf In db.TableDefs If (tdf.Attributes And dbAttachedTable) = _ dbAttachedTable Then tdf.Connect = ";DATABASE=" & "D:\بـرنـامـج الـخـيـاط\data\data.mdb" tdf.RefreshLink End If Next Call SysCmd(acSysCmdClearStatus) If blnSilent Then MsgBox " تم العوده الى النسخه الأصليه مره أخرى ", vbInformation, " بـرنـامـج الـخـيـاط : النسخه الأصليه " End If alalal: If err.Number = 3024 Then MsgBox " عفوا مجلد البيانات تم نقلة أو أعادة تسميتة " & Chr(13) & " لذا سوف يتم اغلاق البرنامج " & Chr(13) & " رجاء أذهب الى مصدر البرنامج وتأكد من وجود مجلد باسم " & Chr(13) & " بجوار ملف بـرنـامـج الـخـيـاط DATA ", vbYes, " بـرنـامـج الـخـيـاط : خطــــــأ " DoCmd.Quit End If وهذا عند النسخ If [AnotherDB] = True Then [ThisDB] = False [OpenDB].Enabled = True [StrOld] = Null Else [ThisDB] = True [OpenDB].Enabled = False [StrOld] = "D:\بـرنـامـج الـخـيـاط\data\data.mdb" End If انا اللي اريده هو بدل الربط يكون تغير في الجداول وليس الربط كل هذا انا عارفه وللاسف ماقدرت اوصلك المعلومه واتعبتك معيا انا هناء اريد الاستيراد وليس ربط On Error GoTo aaaa If IsNull(Forms![استرجاع_البيانات]![النسخه]) Then MsgBox " من فضلك انقر فوق إختيار ملف لتحديد النسخه المراد استرجاعها ", vbInformation, " بـرنـامـج الـخـيـاط : استرجاع بيانات " DoCmd.GoToControl "استعراض" Else Call acbRelink(Me.النسخه, True) DoCmd.Close aaaa: If err.Number = 3011 Then MsgBox " مصرح بإسترجاع البيانات المنسوخه أو المحفوظه " & Chr(13) & " عن طريق ( بـرنـامـج الـخـيـاط ) فقط ", vbInformation, " بـرنـامـج الـخـيـاط : خطــــــــأ " النسخه = Null End If End If هذه العبارة هي ربط Call acbRelink(Me.النسخه, True) استدعاء من هذه الداله Public Function acbRelink(strPath As String, Optional blnSilent As Boolean) As Boolean On Error GoTo alalal Call SysCmd(acSysCmdSetStatus, "Re-linking the data tables...") Set db = CurrentDb() For Each tdf In db.TableDefs If (tdf.Attributes And dbAttachedTable) = _ dbAttachedTable Then tdf.Connect = ";DATABASE=" & "D:\بـرنـامـج الـخـيـاط\data\data.mdb" tdf.RefreshLink End If Next Call SysCmd(acSysCmdClearStatus) If blnSilent Then MsgBox " تم العوده الى النسخه الأصليه مره أخرى ", vbInformation, " بـرنـامـج الـخـيـاط : النسخه الأصليه " End If alalal: If err.Number = 3024 Then MsgBox " عفوا مجلد البيانات تم نقلة أو أعادة تسميتة " & Chr(13) & " لذا سوف يتم اغلاق البرنامج " & Chr(13) & " رجاء أذهب الى مصدر البرنامج وتأكد من وجود مجلد باسم " & Chr(13) & " بجوار ملف بـرنـامـج الـخـيـاط DATA ", vbYes, " بـرنـامـج الـخـيـاط : خطــــــأ " DoCmd.Quit End If End Function انا فاهم برنامجي كويس وللاسف عيبي اني ما قدرت اوصل المقصود وما اريد انا لا اريد ربط كما تكرمت لان الربط عند فتح البرنامج من جديد يرجع للقاعدة الرئيسيه \بـرنـامـج الـخـيـاط\data\data.mdb وهذا مااريده واريد ان في حاله الاستيراد يستبدل الجداول فقط بشرط واذا لم اجد حلا فانا مضطر امشي كما كنت وتحياتي لك واسف مرة اخرى

up

اتفضل اعمل للنموذج والجدول استيراد وعندما تريد تغير التاريخ اعمل امر بفتح نموذج date واختار التاريخ تحياتي ابو ياسين Tailor ‫‬.rar

هذا طلبي هو الان ينشاء مجلد اسمه Backup ويعمله داخه نسخه بتاريخ النسخ المطلوب كيف اعمل استعاده اي نسخه من هذه النسخ وهذا المرفق Backup.rar

انا عندي هذا الكود في النسخ وهو ممتاز بالنسبه للنسخ ولكن اريد كود للستيراد كيف يتم ذلك On Error GoTo MyErr If IsNull([StrOld]) Then MsgBox " من فضلك حدد قاعدة البيانات التي ترغب في نسخها ", vbInformation, " بـرنـامـج الـخـيـاط : خطــــــأ " OpenDB_Click Exit Sub End If If IsNull([StrNew]) Then MsgBox " من فضلك حدد مسار حفظ قاعدة البيانات الجديدة ", vbInformation, " بـرنـامـج الـخـيـاط : خطــــــأ " SaveDB_Click Exit Sub End If If IsNull([الاسم]) Then MsgBox " من فضلك أختر أسم لقاعدة البيانات الجديدة ", vbInformation, " بـرنـامـج الـخـيـاط : خطــــــأ " DoCmd.GoToControl "الاسم" Exit Sub End If Dim OldFile As String, DBwithEXT, DBwithoutEXT, NewFile As String, CopyMyDB OldFile = [StrOld] DBwithEXT = Dir(OldFile) DBwithoutEXT = Left(DBwithEXT, Len(DBwithEXT) - 4) If [BKUP] = True Then NewFile = [StrNew] & "\" & [الاسم] & "-" & Format(Date, "yyyy-mm-dd") & "-" & Format(Now(), "Hh-Nn-AMPM") & Right(DBwithEXT, 4) CopyMyDB = "cmd.exe /C copy " & """" & OldFile & """" & " " & """" & NewFile & """" Shell CopyMyDB, 0 Do Until CheckMyFile(NewFile) = 1 Loop MsgBox " تم عمل نسخة من قاعدة البيانات في الموقع المحدد ", vbInformation, " بـرنـامـج الـخـيـاط : حفـــظ " If [CloseMe] = True Then DoCmd.Close Exit Sub End If Dim NewTempFile As String, NewCompFile As String If [COMP] = True Then NewTempFile = [StrNew] & "\" & "ALALAL-أبو ياسين" & Right(DBwithEXT, 4) NewCompFile = [StrNew] & "\" & [الاسم] & "-" & Format(Date, "yyyy-mm-dd") & "-" & Format(Now(), "Hh-Nn-AMPM") & Right(DBwithEXT, 4) CopyMyDB = "cmd.exe /C copy " & """" & OldFile & """" & " " & """" & NewTempFile & """" Shell CopyMyDB, 0 Do Until CheckMyFile(NewTempFile) = 1 Loop End If If Application.CompactRepair(SourceFile:=NewTempFile, DestinationFile:=NewCompFile, LogFile:=True) = True Then MsgBox " تم عمل نسخة من قاعدة البيانات في الموقع المحدد ", vbInformation, " بـرنـامـج الـخـيـاط : حفـــظ " Else MsgBox " لم تنجح عملية النسخ ", vbInformation, " بـرنـامـج الـخـيـاط : خطــــــأ " End If Kill (NewTempFile) If [CloseMe] = True Then DoCmd.Close MyErr: If err.Number = 7847 Then MsgBox " يوجد ملف بنفس الاسم لذا تم تغيير اسم النسخه الجديدة ", vbInformation, " بـرنـامـج الـخـيـاط : خطــــــأ " End If

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

استاذي ابو خليل والله ليس لم يعجبني النقاش ولكن انا عامل ارتباط بالقاعده data وعامل مسار القاعده في الدي مجلد data وعامل بالبرنامج عند الاقلاع ياخذ من القاعده data Public Function acbRelink2(strPath As String, Optional blnSilent As Boolean) As Boolean On Error GoTo alalal Call SysCmd(acSysCmdSetStatus, "Re-linking the data tables...") Set db = CurrentDb() For Each tdf In db.TableDefs If (tdf.Attributes And dbAttachedTable) = _ dbAttachedTable Then tdf.Connect = ";DATABASE=" & "D:\data\data.mdb" tdf.RefreshLink End If Next Call SysCmd(acSysCmdClearStatus) alalal: If err.Number = 3024 Then DoCmd.Beep MsgBox " ÚÝæÇ ãÌáÏ ÇáÈíÇäÇÊ Êã äÞáÉ Ãæ ÃÚÇÏÉ ÊÓãíÊÉ " & Chr(13) & " áÐÇ ÓæÝ íÊã ÇÛáÇÞ ÇáÈÑäÇãÌ " & Chr(13) & " ÑÌÇÁ ÃÐåÈ Çáì ãÕÏÑ ÇáÈÑäÇãÌ æÊÃßÏ ãä æÌæÏ ãÌáÏ ÈÇÓã " & Chr(13) & " ÈÌæÇÑ ãáÝ ÈÜÑäÜÇãÜÌ ÇáÜÎÜíÜÇØ DATA ", vbYes, " ÈÜÑäÜÇãÜÌ ÇáÜÎÜíÜÇØ : ÎØÜÜÜÜÜÜà " DoCmd.Quit End If End Function

اتفضل التعديل الاخير الحذف بشرط رصيد صفر (3).rar

اتفضل هذا التعديل الاخير الحذف بشرط رصيد صفر.rar

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