ابو جودي

ضع الكود الاتى فى موديول Public Function DayAr(dtDate) Dim strSat As String Dim strSun As String Dim strMon As String Dim strTues As String Dim strWed As String Dim strThurs As String Dim strFri As String strSat = ChrW("1575") & ChrW("1604") & ChrW("1587") & ChrW("1576") & ChrW("1578") strSun = ChrW("1575") & ChrW("1604") & ChrW("1575") & ChrW("1581") & ChrW("1583") strMon = ChrW("1575") & ChrW("1604") & ChrW("1575") & ChrW("1579") & ChrW("1606") & ChrW("1610") & ChrW("1606") strTues = ChrW("1575") & ChrW("1604") & ChrW("1579") & ChrW("1604") & ChrW("1575") & ChrW("1579") & ChrW("1575") & ChrW("1569") strWed = ChrW("1575") & ChrW("1604") & ChrW("1575") & ChrW("1585") & ChrW("1576") & ChrW("1593") & ChrW("1575") & ChrW("1569") strThurs = ChrW("1575") & ChrW("1604") & ChrW("1582") & ChrW("1605") & ChrW("1610") & ChrW("1587") strFri = ChrW("1575") & ChrW("1604") & ChrW("1580") & ChrW("1605") & ChrW("1593") & ChrW("1577") DayAr = Choose(Weekday(dtDate), strSun, strMon, strTues, strWed, strThurs, strFri, strSat) End Function يمكنك الان الحصول على اسم اليوم بالعربية لاى تاريخ من خلال استدعاء الروتين السابق باحد الاكواد الاتية - اسم اليوم الحالى من التاريخ الحالى DayAr(Date()) اسم اليوم بناء على تاريخ ما DayAr([[Fild Date Name])

مشاركة مع استاذى الجليل ومعلمى القدير @د.كاف يار هذه فكرتى المتواضعة IMAGE (Judy).accdb

اتفضل

طيب بالرغم من اننى كنت انتظر الرد عن نتيجة التجربة وابداء رايكم الكريم فى الفكرة الا انه طالما تم التأشير بأفضل اجابة يبدو انها بفضل الله تعالى نالت رضاكم وللعلم انا شخصيا الفكرة عجبتنـــــى

السلام عليكم استاذ @alriashi هذا المرفق يحتوى على اللبنة الأولى لبناء قاعدة البيانات طبعا عذا من وجهة نظرى المتواضعة وعلى قدر تفكيرى البسيط قدر يكون لأحد اساتذتى العظماء رأى مغاير ومخالف لفكرتى ان شاء الله تعالى غدا ان كنا من اهل الدنيا اكمل الباقى . الانت انتهيت من تصميم الجداول المناسبة ومن نماذج ادخال وتسجيل البيانات وتم وضع كود عند التحديث للرقم الشحصى فى النموذج اللرئيسى frmPersonalData يبحث عن الرقم ان كان موجود من الاساس فى البيانات الرئيسية أو بيانات الاقارب من خلال استعلام التوحيد qryUnionPrsNo فى حالة ان الرقم موجود مسبقا تفيد رسالة بذلك مع التوجه للسجل الذى به هذا الرقم ... سوف اقدم باقى افكارى غدا ان شاء الله بعد تجربتكم لذلك الجزء مبدئيا وافادتى بنتيجة التجربة Data Registration.mdb

اولا لابد من اضافة المكتبة الاتية Microsoft Scripting Runtime بدون اضافة المكتبة لن يعمل الكود طيب الكود الاتى فى المديول لانشاء المجلدات Option Compare Database Option Explicit 'Requires reference 'set a reference >>---> Microsoft Scripting Runtime #If Win64 Then Private Declare PtrSafe Function PathIsRelative Lib "Shlwapi" _ Alias "PathIsRelativeA" (ByVal Path As String) As Long #Else Private Declare Function PathIsRelative Lib "Shlwapi" _ Alias "PathIsRelativeA" (ByVal Path As String) As Long #End If Public Enum EMakeDirStatus ErrSuccess = 0 ErrRelativePath ErrInvalidPathSpecification ErrDirectoryCreateError ErrSpecIsFileName ErrInvalidCharactersInPath End Enum Const MAX_PATH = 260 Function MakeMultiStepDirectory(ByVal PathSpec As String) As EMakeDirStatus '''''''''''''''''''''''''' ' MakeMultiStepDirectory ' '''''''''''''''''''''''''' Dim FSO As Scripting.FileSystemObject Dim DD As Scripting.Drive Dim B As Boolean Dim Root As String Dim DirSpec As String Dim N As Long Dim M As Long Dim S As String Dim Directories() As String Set FSO = New Scripting.FileSystemObject ' ensure there are no invalid characters in spec. On Error Resume Next Err.Clear S = Dir(PathSpec, vbNormal) If Err.Number <> 0 Then MakeMultiStepDirectory = ErrInvalidCharactersInPath Exit Function End If On Error GoTo 0 ' ensure we have an absolute path B = CBool(PathIsRelative(PathSpec)) If B = True Then MakeMultiStepDirectory = ErrRelativePath Exit Function End If ' if the directory already exists, get out with success. If FSO.FolderExists(PathSpec) = True Then MakeMultiStepDirectory = ErrSuccess Exit Function End If ' get rid of trailing slash If Right(PathSpec, 1) = "\" Then PathSpec = Left(PathSpec, Len(PathSpec) - 1) End If ' ensure we don't have a filename N = InStrRev(PathSpec, "\") M = InStrRev(PathSpec, ".") If (N > 0) And (M > 0) Then If M > N Then ' period found after last slash MakeMultiStepDirectory = ErrSpecIsFileName Exit Function End If End If If Left(PathSpec, 2) = "\\" Then ' UNC -> \\Server\Share\Folder... N = InStr(3, PathSpec, "\") N = InStr(N + 1, PathSpec, "\") Root = Left(PathSpec, N - 1) DirSpec = Mid(PathSpec, N + 1) Else ' Local or mapped -> C:\Folder.... N = InStr(1, PathSpec, ":", vbBinaryCompare) If N = 0 Then MakeMultiStepDirectory = ErrInvalidPathSpecification Exit Function End If Root = Left(PathSpec, N) DirSpec = Mid(PathSpec, N + 2) End If Set DD = FSO.GetDrive(Root) Directories = Split(DirSpec, "\") DirSpec = DD.Path For N = LBound(Directories) To UBound(Directories) DirSpec = DirSpec & "\" & Directories(N) If FSO.FolderExists(DirSpec) = False Then On Error Resume Next Err.Clear FSO.CreateFolder (DirSpec) If Err.Number <> 0 Then MakeMultiStepDirectory = ErrDirectoryCreateError Exit Function End If End If Next N MakeMultiStepDirectory = ErrSuccess End Function وتسهيلا ولاضفاء مرونة فى الاستخدام قمت بكتابة الروتين الاتى ليتم استخدامة هو فقط Public Function MD(strPathDr) As EMakeDirStatus MD = MakeMultiStepDirectory(strPathDr) End Function يتم استدعاء الروتين من خلال MD(***) مع تغيير الـ *** بالمسار للمجلدات على سبيل المثال لو اردنا عمل مجلد فى القطاع D على ان يكون اسمه Officena ونريد بداخله مجلد باسم Access ونريد بجوار المجلد Access مجلد باسم Moh3sam وبداخلة مجلد باسم Judy وبداخل مجلد مجلد Access مجلد باسم VBA يكون الكود كالأتى MD("D:\Officena\Access\VBA") MD("D:\Officena\Moh3sam\Judy")

واتفضل هذا مثال فقط ينقصه اعادة ربط الجداول المرتبطة من قاعدة الخلفية فقط حتى يعمل النسخ الاحتياطى على اكمل وجه frontend.mdb db.mdb

اتفضل يا سيدى جرب الكود الاتى ورد على من فضلك هل تم تنفيذ النسخ التلقائى لقاعدة بيانات الجداول ملاحظة هامة لن تحتاج لتحديد مسار قاعدة البيانات الخلفية ولا لتعديل اى شئ فقط استخدم الكود الاتى ,, كذلك وضعت تقريبا شرح لكل شئ على الكود '-----------------------------------------------------------' '-----------------------------------------------------------' ' _ +-----------officena-----------+ _ ' ' /o) | ||||| | (o\ ' ' / / | @(~O^O~)@ | \ \ ' ' ( (_ | _ ----oOo--Moh--oOo----- _ | _) ) ' ' ((\ \) +/o)----------3ssam---------(o\+ (/ /)) ' ' (\\\ \_/ / \ \_/ ///) ' ' \ / \ / ' ' \____/________Mohammed Essam________\____/ ' '--25-10-2021-----------------------------------------------' '-----------------------------------------------------------' Option Compare Database Option Explicit Function RunSub() Dim dbs As DAO.Database Dim tdf As DAO.TableDef Dim strPathDB As String Dim strNameExtensionDB As String Dim strNameDB As String Dim strExtensionDB As String Dim strBackupPath As String Dim strNewNameBackupDB As String Dim fso As Object Dim Syso As Object Set dbs = CurrentDb() With dbs For Each tdf In .TableDefs 'Is the table a linked table? If tdf.Attributes And dbAttachedODBC Or tdf.Attributes And dbAttachedTable Then With tdf 'Connect property contains path of link strPathDB = .Properties("Connect").Value 'Path of linked database tables strPathDB = Replace(strPathDB, ";DATABASE=", vbNullString) End With End If Next tdf End With 'Backup path directory strBackupPath = CurrentProject.Path & "\Backup\" Set fso = CreateObject("scripting.filesystemobject") 'Create the Backup folder if it does not exist If Not fso.FolderExists(strBackupPath) Then fso.createfolder (strBackupPath) 'Database name with extension strNameExtensionDB = Right(strPathDB, Len(strPathDB) - InStrRev(strPathDB, "\")) 'Database name without extension strNameDB = Left(strNameExtensionDB, InStrRev(strNameExtensionDB, ".") - 1) 'extension only strExtensionDB = Right(strPathDB, Len(strPathDB) - InStrRev(strPathDB, ".")) 'New name for backup database strNewNameBackupDB = strNameDB & "-Backup-" & Format(Now, "mm-yyyy") & "." & strExtensionDB 'Backup database save path directory strBackupPath = strBackupPath & strNewNameBackupDB DBEngine.Idle 'Copy the backup database to its directory Set Syso = CreateObject("Scripting.FileSystemObject") Syso.copyfile strPathDB, strBackupPath Set Syso = Nothing DoCmd.RunCommand acCmdExit End Function

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

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

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

وفين الحقل الخاص برقم البطاقة اصلا ؟ هل هو الرقم الشخصى ؟!....... ياريت تحدد طلبك رقم البطاقة هاد يخص مين تحديد وهل موجود باكثر من جدول واللا لاء وماذا تقصد بالنموذج الاول ولو فى اكثر من اسم متشابه ايه الحل ؟؟؟؟ - يعنى مثلا فى محمد وله قريب اسمه صالح ههههههه صالح يجى مع مين محمد واللا احمد ؟!

وعليكم السلام ورحمة الله تعالى وبركاته غير الكود التى فى الموديول تبعا للشرح الاتى Function RunSub() Dim fso As Object Dim fldrname As String Dim fldrpath As String Dim MyFile, DstFile As String Dim Syso As Object Set fso = CreateObject("scripting.filesystemobject") fldrpath = CurrentProject.Path & "\Backup" If Not fso.FolderExists(fldrpath) Then fso.createfolder (fldrpath) MyFile ="***" & "\" & "db.accdb" DstFile = CurrentProject.Path & "\Backup\Backup-" & Format(Now, "mm-yyyy") & ".accdb" DBEngine.Idle Set Syso = CreateObject("Scripting.FileSystemObject") Syso.copyfile MyFile, DstFile Set Syso = Nothing DoCmd.RunCommand acCmdExit End Function غير ال *** ل اسم الجهاز السيرفر او IP حق الجهاز السيرفر على ان يكون بهذا الشكل مثلا... \\192.168.1.3 فيكون السطر بهذا الشكل بعد التعديل MyFile ="\\192.168.1.3" & "\" & "db.accdb" وفى حالة اسم الجهاز يكون بعذا الشكل MyFile ="\\servername" & "\" & "db.accdb"

معلش ممكن تفصيلا للموظف كمال 1 سنة , 5 أشهر , 13 يوم كيف تم احتسابهم

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

نعم ممكن ذلك ان كانت قاعدة البيانات تعمل ضمن شبكة محلية بشرط ان تكون قاعدة الجداول موجوده على مجلد داخل مجلد اون درايف على سبيل المثال هذا مسار المجلد فى الجهاز C:\Users\Moh3ssam\OneDrive\ShardDB يتم عمل مشاركة لهذا المجلد وبذلك يكون مسار القاعدة لباقى الاجهزة \\192.168.1.3\ShardDB الان يمكن لاى مستخدم ضمن الشبكة المحلية العمل على قاعدة البيانات ضمن تلك الشبكة من خلال مشاركة المجلد ومن ناحية أخرى قاعدة الجداول يتم مزامنتها تلقائيا على حساب on drive ولا يمكن الوصول الى المجلد عبر السحابة الا من واقع صاحب الحساب وان كانت قاعدة البيانات مقسمة الى قاعدتين امامية وخلفية لن يكون قادرا على التعامل مع القاعدة ان كان خارج الشبكة المحلية

اتفضل ان شاء تجد الالية هنا ان لم تتمكن من الفهم او التطبيق كرما وفضلا وليس امر ارفق قاعدتك ليتم عمل الازم Multi Filters.mdb

ممكن مرفق

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

انت الاجمل اتفضل يا استاذ @Moosak جزاكم الله خيرا لتلبية دعوتى اتمنى لا تتفزع من هذا المرفق 😄 Moosak.accdb

برامج الانتى قايروس أو حاولت عمل ضغط واصلاح للقاعدة والقاعدة كانت معلقة لم تغلق كليا لتلافى تلك المشكلة بنسبة 99% قم بوضع كلمة مرور لحماية الاكواد

بانتظار النتيجة واتمنى ارفاق لقطة شاشة حية من التجربة مع رأيكم من واقع التجربة تجربة شيقة.zip

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