كيف اقوم بعمل تحديث للبرنامج عند المستخدمين دون عناء التحديث يدوي ؟

[hassan123]

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

استكمالا لاستبدال التحديث عن طريق حقل  Attatchment  في الجدول (xVer)الجدول المضاف للبرنامج والاستغناء عن مجلد المشاركة Share folder ولأهمية موضوع التحديث حيث لا يقل أهمية عن تصميم البرنامج بحد ذاته ، خصوصا اذا كان البرنامج يرتبط بأكثر من مستخدم ومعاناة التحديث اليدوي على كل جهاز مما قد يؤدي الى ارهاق المبرمج وكثرة الأخطاء 

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

 

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

 

المرفق التالي لمن أراد الاستفادة 

ولتطبيق الطريقة فك الضغط عن المرفق في البارتشن C مباشرة  ومن ثم الدخول على المجلد (Shaoon) وتشغيل البرنامج (Shaoon.accdb)

 

 

MyProgram2.rar

تم تعديل مارس 25 بواسطه hassan123

[Foksh]

متابعة جميلة وذكية أخونا @hassan123 🤗

[Moosak]

متألق ما شاء الله عليك أخي @hassan123 🙂 ..

أفكار إبداعية جديدة 😄👌

 

ملاحظات وأفكار 🙂 :

1 - لاحظت أنك أدرجت ملف التحديث من ضمن الملفات ولا أضنك ستحتاج إليه بعد الآن مع التحديث الجديد 🙂 :

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

وهذا الكود الذي أستخدمه أنا لغرض إنشاء ملف ال VBS يمكنك الاستفادة من إن أحببت 🙂 :

' Updater VBS File Path
dim UpdaterFilePath
UpdaterFilePath = CurrentProject.Path & "\Updater.VBS" 

'  ************************************************** delete Old Updater File
    
    If Len(Dir(UpdaterFilePath, vbDirectory)) > 0 Then
        Kill (UpdaterFilePath)
    End If

'  ************************************************** Write The VBS File Which Updates The DB
Dim FSO
Set FSO = CreateObject("Scripting.FileSystemObject")
Dim oFile

dim txtOldFEPath 
dim txtNewFEPath 
txtOldFEPath = "E:\Open DB\الملف المصدر.accdb"
txtNewFEPath = "E:\Open DB\الملف الهدف.accdb"

' Creat vbs File with ANSI Coding ' الترميز الذي يدعم العربية
Set oFile = FSO.CreateTextFile(UpdaterFilePath, True, False)
    
    oFile.WriteLine "Dim fs, strCopyFrom, strCopyTo"
    oFile.WriteLine "Set fs = CreateObject(""Scripting.FileSystemObject"")"

'    Start writing The Updater File
'    sleep 3 seconds
    oFile.WriteLine "Dim SecWait"
    oFile.WriteLine "SecWait = DateAdd(""s"", 3, Now())"
    oFile.WriteLine "Do Until (Now() = SecWait)"
    oFile.WriteLine "Loop"

'    copy files
    oFile.WriteLine "strCopyFrom = " & """" & txtNewFEPath & """"
    oFile.WriteLine "strCopyTo = " & """" & txtOldFEPath & """"
    
    oFile.WriteLine "fs.CopyFile strCopyFrom, strCopyTo, True"
    
'    open the new version
    oFile.WriteLine "CreateObject(""Shell.Application"").Namespace(0).ParseName(strCopyTo).InvokeVerb ""Open"""
    
    oFile.WriteLine "Set fs = Nothing"
    
    oFile.Close
Set FSO = Nothing
Set oFile = Nothing
    
    
'  ************************************************** Open the VBS Updater File

Shell "explorer.exe" & " " & UpdaterFilePath, vbMinimizedNoFocus

'  ************************************************** Close FE Database
Application.Quit

 

3- أزيدك من الشعر بيت 😄 .. هذا كود لإضافة ملف التحديثات الجديدة لحقل المرفقات في الجدول بطريقة سهلة ( يفتح مستعرض الملفات >> تختار ملف التحديث >> وتم بحمد الله ) 🙂 

Option Compare Database
Option Explicit


Public Sub AddAttacmentToTable(TableName As String, AttachmentFieldName As String, IDField As String, IDvalue As Long)
'TableName = اسم الجدول
'AttachmentFieldName = اسم حقل المرفقات
'IDField = اسم حقل الآيدي
'IDvalue = رقم الآيدي

On Error GoTo HandleError
    
    Dim db As DAO.Database
    Dim rs As DAO.Recordset
    Dim attachFld As DAO.Recordset
    
    Dim file As String
    
    file = selectFile

    Set db = CurrentDb
    Set rs = db.OpenRecordset("select * from " & TableName & " where " & IDField & " = " & IDvalue & ";")    ' Or OpenRecordset("TableName")
'    Debug.Print "select * from " & TableName & " where " & IDField & " = " & IDvalue & ";"
    If Not rs.BOF And Not rs.EOF Then
        rs.MoveFirst
        rs.Edit
  
             Set attachFld = rs.Fields(AttachmentFieldName).Value
  
            attachFld.AddNew
            attachFld.Fields("FileData").LoadFromFile file
            attachFld.Update
        rs.Update
    End If
    
MsgBox "done"
    
    rs.Close
    Set db = Nothing
    Set rs = Nothing

HandleExit:
Exit Sub

HandleError:
If Err.Number = 0 Then
Exit Sub
Else
MsgBox Err.Number & vbNewLine & vbNewLine & Err.Description
End If
Resume HandleExit
End Sub



Public Function selectFile()
' دالة مستعرض الملفات
    On Error GoTo ErrHandler
    
    Dim fd As Object
    Dim filedialogPath As String
    
    Set fd = Application.FileDialog(1)
    
    fd.AllowMultiSelect = False
    fd.Title = "حدد الملف المطلوب"
'    fd.InitialFileName = CurrentProject.Path
    fd.Filters.Clear
    fd.Filters.Add "كل الملفات", "*.*"
      
    If fd.Show = True Then
    selectFile = fd.SelectedItems(1)
'    Exit Function
    Else
    MsgBox "لم تقم باختيار أي ملف"
    Exit Function
    End If

ErrHandler:
    If Err.Number = 0 Then Exit Function Else
    MsgBox "Error Number : " & Err.Number & " :::: " & Err.Description
'    End If
    
End Function

Sub testing()
'للتجربة
AddAttacmentToTable "att", "Att_T", "ID", 4

End Sub

مع تمنياتي لك بالتوفيق 🙂 

[hassan123]

اشكرك استاذي الكريم @Moosak على الاضافة الجميلة والهامة  ☺️