Foksh

أخونا الكريم @zero1111330566 ، وجب عليك ان تنسب أفضل إجابة للأستاذ @kkhalifa1960 صاحب الإجابة التي ناسبتك وحلت لك المشكلة ، وليس لك يا صديقي

شافاكم الله وعافاكم أستاذ @Eng.Qassim

وأنا أدعم كلام الأستاذ @kkhalifa1960 ، للحصول على حلول أسرع ، يفضل طرح كل مشكلة في موضوع مستقل . لا أن يقوم صاحب الموضوع بطلب 10 طلبات في موضوع واحد ضمن موضوعه . ولا أتحدث عن صاحب الموضوع بوجه التحديد بل بشكل عام . كل الإحترام والتقدير لأخونا العزيز @zero1111330566

اعتقد وجوب ارسال ملف سيفي بالغرض ، ولكن لم تخاف من التجربة . إن لم تجرب فلن تعرف طريق الحل الذي قمت به هو فعلاً صحيح أم لا . في حال عدم نجاح فكرتك بعد اضافة حقل ترقيم تلقائي كمفتاح أساسي ( أو حسب حاجتك ) لزم الأمر ملف مرفق في موضوع مستقل وإغلاق هذا الموضوع باختيار افضل إجابة حتى لا نتعارض مع سياسة المنتدى

يسعدني نجاح الفكرة بعد تجربتها بأكثر من مستخدم ، أشكرك مهندسنا

إحنا نروح الشرطة

سيتم تحديث الملف الذي يتم تنزيله من التحديث بين فترة وأخرى ، لضمان أن الفكرة تعمل بدون مشاكل

1. حجم قاعدة البيانات الخلفية ( الجداول ) أكثر من 20 ميجا ، وهي تحتوي فقط 7 جداول . يجب أولاً عمل ضغط و إصلاح لمشروعك . 2. قاعدة البيانات الرئيسية اشتغلت معي على اصدار 32 ما في مشكلة ، المشكلة التي ستواجهك عند تحويل المشروع الى Accde 3. من الناحية البرمجية ، وجدت ما يلي في أكواد الـ VBA :- في النموذج VPA ، لديك مشاكل في عدم العثور على بعض العناصر ، مثل :- ( في الحدث Ctl1_GotFocus :- العنصر Ctl1 غير موجود وما يتبعه في الجملة الشرطية ) ( في الحدث أمر4_Click :- العنصر أمر4 غير موجود ايضاً وما يتبعه في الجملة الشرطية ) المشكلة التي قد تواجهك حالياً في مديول اخفاء واجهة آكسيس لديك ، حاول استبدل الكود السابق بهذا التعديل ، وقم بتجربته . Option Compare Database Option Explicit Global Const SW_HIDE = 0 Global Const SW_SHOWNORMAL = 1 Global Const SW_SHOWMINIMIZED = 2 Global Const SW_SHOWMAXIMIZED = 3 #If VBA7 Then Private Declare PtrSafe Function apiShowWindow Lib "user32" _ Alias "ShowWindow" (ByVal hWnd As LongPtr, _ ByVal nCmdShow As Long) As Long #Else Private Declare Function apiShowWindow Lib "user32" _ Alias "ShowWindow" (ByVal hWnd As Long, _ ByVal nCmdShow As Long) As Long #End If Function fSetAccessWindow(nCmdShow As Long) Dim loX As Long Dim loForm As Form On Error Resume Next Set loForm = Screen.ActiveForm If Err <> 0 Then loX = apiShowWindow(hWndAccessApp, nCmdShow) Err.Clear End If If nCmdShow = SW_SHOWMINIMIZED And loForm.Modal = True Then MsgBox "Cannot minimize Access with " _ & (loForm.Caption + " ") _ & "form on screen" ElseIf nCmdShow = SW_HIDE And loForm.PopUp <> True Then MsgBox "Cannot hide Access with " _ & (loForm.Caption + " ") _ & "form on screen" Else loX = apiShowWindow(hWndAccessApp, nCmdShow) End If fSetAccessWindow = (loX <> 0) End Function وهذه نسخة محفوظة من إصدار 32 بت ، جربه sader warid- form 32x.zip هذا رأيي وغير ملزم ، والله أعلم

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

امامك عدة حلول ، 1. تحويل البرنامج ليعمل على إصدار 32 بت بأن تقوم بحفظ النسخة الجديدة من اصدار 32 بت . 2. تعديل الأكواد لتكون متوافقة مع الإصدارين 32 و 64 . 3. تثبيت نسخة 64 بت على الأجهزة الثانية . 4. وهناك حل آخر وهو استخدام Access Runtime (32 بت) ، بأن يتم تثبيته على الاجهزة التي تريدها .

مشاركة سريعة .. جرب هذا الكود للزر Private Sub Command_Click() Dim FolderPath As String Dim FileName As String Dim FileSystem As Object FolderPath = CurrentProject.Path & "\Data\QR_images\" Set FileSystem = CreateObject("Scripting.FileSystemObject") If FileSystem.FolderExists(FolderPath) Then FileName = Dir(FolderPath & "*.*") Do While FileName <> "" If FileSystem.FileExists(FolderPath & FileName) Then Kill FolderPath & FileName End If FileName = Dir() Loop Else MsgBox "المجلد غير موجود", vbExclamation, "خطأ" End If MsgBox "تم حذف جميع الصور بنجاح", vbInformation, "تم" End Sub Database.accdb

السلام عليكم ورحمة الله وبركاته ، أخواني وأساتذتي ومعلمينا ( دون استثناء ) بالإشارة الى الموضوع الذي أعلنت عنه سابقاً في هذا الرابط هنا ، اسمحوا لي بأن أطرح هذه الفكرة الجديدة والتي تم تجربتها مراراً وتكراراً إلى أن خرجت بهذه النتيجة فيما يتعلق بموضوع التحديث الهوائي أو Online أو OTA ( Over-The-Air ) . الموضوع بداية بسيط جداً ولن يحتاج تعقيد في تنفيذ هذه الطريقة . حيث ما يلزمنا أولاً هو حساب على Google Drive ( لماذا ؟ = لأن 95 % من الأشخاص عندهم هذا الحساب ) . و حساب على موقع Dropbox ( لماذا ؟ = لأنه يعطينا امكانية التحميل برابط مباشر خلافاً في جوجل درايف ) وهو ما يميزه عن Google Drive . بناءً على ما سلف ، نبدأ شرح الخطوات والمتطلبات على بركة الله :- 1. سنحتاج جدول واحد مرفق وهو ( Settings ) ، ولا أنصح بالتلاعب به ما لم يكن على أساس صحيح ؛ ويحتوي على الحقول التالية :- الحقل Ver = رقمي = لتحديد الإصدار الحالي للنسخة الحالية في قاعدة البيانات الحالية. الحقل Link = نصي = لتحديد رابط الملف النصي الذي سيتم قراءة الإصدار الجديد منه ومقارنته مع قيمة الحقل Ver لتحديد ما اذا كان هناك نسخة جديدة أم لا . الحقل URLS = نصي = سيتم ادراج رابط التحميل للإصدار الجديد من خلال الكود تلقائياً. الحقل DBName = نصي = سيمكانك هنا من تحديد اسم قاعدة البيانات التي سيتم حفظ التحديث الجديد بها . وهنا لتسهيل فكرة اسم القاعدة القديمة واستبدالها بالنسخة الجديدة سيتم جلب القيمة تلقائياً . الحقل Auto_Check = نوع Yes/No = لتفعيل ميزة الفحص التلقائي للتحديثات ( فكرة شبيهة بتلك التي في أجهزة الجوال والمحمول عند تفعيلها يصلك إشعارك بوجود نسخة جديدة إن كانت الميزة مفعلة طبعاً ) 2. تحميل الإصدار الجديد على موقع Dropbox ونسخ رابط الملف ( مع التأكد أن الملف عند مشاركته قد تمت مشاركته للجميع - الموقع يجعلها قيمة افتراضية - ولكن للتأكيد ) . 3. ملف نصي واحد ( TxT. ) سميه ما شئت وهو ثابت غير قابل للتبديل ، ويكون محتواه ما يلي :- السطر الأول نضع رقم الإصدار الجديد . اي انه في الملف القديم لنفترض ان قيمة الحقل Ver = 0.1 . هنا في الملف النصي سنضع الإصدار الأحدث أي مثلاً ( 0.2 ). السطر الثاني نضع رابط النسخة الحديثة التي تم رفعها على Dropbox في النقطة السابقة 2 . أي انه سيكون لدينا ملف نصي يحتوي سطرين الأول رقم الإصدار الحديث والذي ستتم قراءته و مقارنته مع الحقل Ver في الإصدار الذي لدى العميل ، والسطر الثاني رابط النسخة الأحدث من دروب بوكس . 4. سنقوم برفع هذا الملف النصي على جوجل درايف ( السبب : دروب بوكس لم يدعم فكرة قراءة الملف النصي وجلب قيمة رقم الاصدار في السطر الأول لمقارنتها مع القيمة في النسخة التي لدى العميل في الحقل Ver ) . 5. ثم سنقوم بنسخ الرابط لهذا الملف النصي ومشاركته للجميع - أو بمعنى آخر لمن يملك الرابط - ولصقه في الجدول الثابت Settings في الحقل Link وهو هنا سيكون أيضاً قيمة ثابتة لن تتغير . أي أنك ستقوم بتغيير فقط رقم الإصدار في النسخة الجديدة في الحقل Ver . وإعادة رفع الملف النصي بعد تحديث قيمة رقم الاصدار الجديد فقط . طبعاً هنا بالإفتراض جدلاً وبعد تجربة متكررة أنه عندما تقوم برفع ملف موجود مسبقاً على أي موقع من ( جوجل درايف أو دروب بوكس ) فأن العنوان لهذا الملف لن يتغير لأنه سيتم استبدال الملف القديم بالجديد . ( وهي نقطة جيدة استفدنا منها لصالحنا ). 6. الآن الفكرة بشكل عام واضحة ولا تحتاج لتعقيد في الشرح ( وأي فكرة أو طريقة في البداية ستحتاج مرات معدودة لتصبح سهلة في تطبيقها عن ظهر قلب ) الآن وما هو مهم للجميع ، الكود التالي للمديول :- '********************************************** '*** *** '*** FFFFFF OOO KK KK SSSS HH HH *** '*** FF O O KK KK SS HH HH *** '*** FFFFF O O KKK SS HHHHHH *** '*** FF O O KK KK SS HH HH *** '*** FF OOO KK KK SSSSS HH HH *** '*** *** '*************** ( 28/12/2024 ) *************** Option Compare Database Option Explicit Public Function IsInternetConnected() As Boolean On Error GoTo ErrorHandler Dim xhr As Object Set xhr = CreateObject("MSXML2.ServerXMLHTTP.6.0") xhr.SetOption 2, 13056 xhr.Open "GET", "https://www.google.com", False xhr.send IsInternetConnected = (xhr.Status = 200) Set xhr = Nothing Exit Function ErrorHandler: IsInternetConnected = False If Not xhr Is Nothing Then Set xhr = Nothing End Function Public Function ConvertGoogleDriveLink(ByVal originalLink As String) As String On Error GoTo ErrorHandler Dim FileID As String If InStr(1, originalLink, "/d/") > 0 Then FileID = Mid(originalLink, InStr(1, originalLink, "/d/") + 3) FileID = Left(FileID, InStr(1, FileID, "/") - 1) ElseIf InStr(1, originalLink, "id=") > 0 Then FileID = Mid(originalLink, InStr(1, originalLink, "id=") + 3) If InStr(1, FileID, "&") > 0 Then FileID = Left(FileID, InStr(1, FileID, "&") - 1) End If End If If Len(FileID) > 0 Then ConvertGoogleDriveLink = "https://drive.google.com/uc?id=" & FileID Else ConvertGoogleDriveLink = originalLink End If Exit Function ErrorHandler: ConvertGoogleDriveLink = originalLink End Function Public Function CheckForUpdate() As Boolean On Error GoTo ErrorHandler Dim currentVer As Double Dim onlineVer As Double Dim xhr As Object Dim onlineContent As String Dim driveLink As String Dim contentLines() As String Dim updateURL As String Dim currentDBName As String currentDBName = CurrentDb.Name currentDBName = Mid(currentDBName, InStrRev(currentDBName, "\") + 1) currentDBName = Left(currentDBName, InStrRev(currentDBName, ".") - 1) CurrentDb.Execute "UPDATE Settings SET DBName = '" & Replace(currentDBName, "'", "''") & "'" currentVer = DLookup("Ver", "Settings") If Not IsInternetConnected() Then Forms!Frm_Index!Lbl_Load.Caption = "أنت تستخدم الإصدار: " & currentVer CheckForUpdate = False Exit Function End If driveLink = ConvertGoogleDriveLink(DLookup("Link", "Settings")) Set xhr = CreateObject("MSXML2.ServerXMLHTTP.6.0") xhr.SetOption 2, 13056 xhr.Open "GET", driveLink, False xhr.setRequestHeader "User-Agent", "Mozilla/5.0" xhr.send If xhr.ReadyState = 4 Then If xhr.Status = 200 Then onlineContent = Trim(xhr.responseText) contentLines = Split(onlineContent, vbCrLf) If UBound(contentLines) >= 1 Then onlineVer = Val(contentLines(0)) updateURL = Trim(contentLines(1)) If onlineVer > 0 Then If onlineVer > currentVer Then CurrentDb.Execute "UPDATE Settings SET URLS = '" & updateURL & "'" Forms!Frm_Index!Lbl_Load.Caption = " تحديث جديد متوفر الآن : " & onlineVer & " Ver - انقر للتحميل " Forms!Frm_Index!ImgUpdate.Visible = True CheckForUpdate = True Forms!Frm_Index!Tx_User.Enabled = True Forms!Frm_Index!Tx_Pass.Enabled = True Forms!Frm_Index!Tx_User.SetFocus Else Forms!Frm_Index!Lbl_Load.Caption = "أنت تستخدم أحدث إصدار : " & onlineVer & " Ver " Forms!Frm_Index!Tx_User.Enabled = True Forms!Frm_Index!Tx_Pass.Enabled = True Forms!Frm_Index!Tx_User.SetFocus End If End If End If End If End If Set xhr = Nothing Exit Function ErrorHandler: CheckForUpdate = False If Not xhr Is Nothing Then Set xhr = Nothing End Function Sub UpdateURLSAndOpenNewDatabase() Dim UrlValue As String, NameValue As String Dim TargetDb As DAO.Database Dim rs As DAO.Recordset Dim CurrentDbPath As String Dim NewDbPath As String CurrentDbPath = CurrentProject.Path & "\" & Dir(CurrentProject.FullName) NewDbPath = CurrentProject.Path & "\Data\Update.accdb" If Dir(CurrentProject.Path & "\Data\Update.Dll") <> "" Then Name CurrentProject.Path & "\Data\Update.Dll" As NewDbPath Else MsgBox "الملف Update.Dll غير موجود", vbCritical Exit Sub End If On Error GoTo ErrorHandler UrlValue = Nz(CurrentDb.OpenRecordset("SELECT URLS FROM Settings").Fields("URLS").Value, "") NameValue = Nz(CurrentDb.OpenRecordset("SELECT DBName FROM Settings").Fields("DBName").Value, "") If UrlValue = "" Or NameValue = "" Then MsgBox "خطأ في تحميل التحديث", vbCritical Exit Sub End If Set TargetDb = DBEngine.OpenDatabase(NewDbPath) Set rs = TargetDb.OpenRecordset("Settings", dbOpenDynaset) If rs.EOF Then rs.AddNew rs.Fields("URLS").Value = UrlValue rs.Fields("DBName").Value = NameValue rs.Update Else rs.MoveFirst rs.Edit rs.Fields("URLS").Value = UrlValue rs.Fields("DBName").Value = NameValue rs.Update End If rs.Close TargetDb.Close Shell "msaccess.exe """ & NewDbPath & """", vbNormalFocus Application.Quit Exit Sub ErrorHandler: MsgBox "حدث خطأ: " & Err.Description, vbCritical If Not rs Is Nothing Then rs.Close If Not TargetDb Is Nothing Then TargetDb.Close Exit Sub End Sub Public Function ExtractAttachmentFile() As Boolean On Error GoTo ErrorHandler Dim db As DAO.Database Dim rs As DAO.Recordset Dim rsAttach As DAO.Recordset2 Dim fld As DAO.Field2 Dim dataFolder As String dataFolder = CurrentProject.Path If Dir(dataFolder, vbDirectory) = "" Then MkDir dataFolder End If Set db = CurrentDb Set rs = db.OpenRecordset("Settings") If Not rs.EOF Then Set fld = rs.Fields("DBFiles") If Not IsNull(fld) Then Set rsAttach = fld.Value If Not rsAttach.EOF Then rsAttach.Fields("FileData").SaveToFile dataFolder & "\" & rsAttach.Fields("FileName").Value ExtractAttachmentFile = True End If rsAttach.Close End If End If CleanUp: If Not rs Is Nothing Then rs.Close Set rs = Nothing Set db = Nothing Exit Function ErrorHandler: ExtractAttachmentFile = False Resume CleanUp End Function وما يلي كود النموذج لجميع الأجزاء والمكونات داخله :- '********************************************** '*** *** '*** FFFFFF OOO KK KK SSSS HH HH *** '*** FF O O KK KK SS HH HH *** '*** FFFFF O O KKK SS HHHHHH *** '*** FF O O KK KK SS HH HH *** '*** FF OOO KK KK SSSSS HH HH *** '*** *** '*************** ( 28/12/2024 ) *************** Option Compare Database Option Explicit Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) Private bMessage20Displayed As Boolean Private bMessage35Displayed As Boolean Private bMessage50Displayed As Boolean Private LoginAttempts As Integer Dim TimeCount As Long Private Sub Btn_Quit_Click() Dim userResponse As VbMsgBoxResult userResponse = MsgBox("إغلاق النظام؟", _ vbYesNo + vbInformation + vbMsgBoxRight, "تأكيد عملية الإغلاق") If userResponse = vbYes Then DoCmd.Quit ElseIf userResponse = vbNo Then DoCmd.CancelEvent End If End Sub Private Sub Form_Load() ExtractAttachmentFile LoginAttempts = 0 Me.Caption = "Foksh - Officena.Net - 2025" DoEvents If Check_Auto = -1 Then Me.TimerInterval = 1000 Else Me.TimerInterval = 0 Me.Lbl_Load.Caption = "" End If End Sub Private Sub Form_Timer() Me.TimerInterval = 0 CheckForUpdate End Sub Private Sub ImgUpdate_Click() On Error GoTo ErrorHandler Dim userResponse As VbMsgBoxResult userResponse = MsgBox("التحديث الآن؟", _ vbYesNo + vbInformation + vbMsgBoxRight, "تأكيد عملية التحديث") If userResponse = vbYes Then UpdateURLSAndOpenNewDatabase ElseIf userResponse = vbNo Then DoCmd.CancelEvent End If ErrorHandler: Resume Next End Sub ما يتم تنفيذه عند استعمال الفكرة :- أولاً عند الفتح للمشروع سيتم استخراج ملف DLL مرفق داخل قاعدة البيانات . ثانياً عند اكتمال التحديث سيتم استبدال النسخة القديمة بالنسخة الجديدة ، وشأنه شأن أي عملية تحديث ؛ فإنك ستفقد النسخة القديمة كاملةً ( وهنا الحاجة الماسة لاعتماد فكرة تقسيم قاعدة البيانات ) . ملف الواجهة المرفق مفتوح المصدر 👈 [ Main.accdb ] * عذراً إن كانت طريقتي في العمل مزعجة أو غريبة نوعاً ما ، لكن هو طبعي 😅 . فماذا أفعل ؟؟!!

السؤال المهم أولاً !!! هل قاعدة البيانات لديك مقسمة الى قاعدة بيانات خلفية ( الجداول ) وقاعدة البيانات الأمامية ( باقي المكونات ) ؟؟؟؟؟ اذا كنت قد قمت بتقسيم القاعدة فمن المفترض ان يتم تفعيل هذا الإجراء بشكل تلقائي دلالة على ان القاعدة الأمامية مرتبطة بقاعدة البيانات الخلفية ( للجداول ) . التوضيح التالي يعتمد على إجابتك !!

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

Dangerous File Blocked قم بضغط الملف ورفعه هنا ، او ارفع قاعدة البيانات مضغوطة دون الحاجة لتحويلها لملف تنصيبي