تخزين قاعدة البيانات في ( جوجل درايف ) مع تاريخ ووقت الارسال

[qathi]

اخوني واساتذتي الافاضل حياكم الله وبعد

بما انه لم يتم الوصول حل للطلب في الموضوع السابق قمت بعمل ملف يوضح بشكل افضل لما هو مطلوب

 

 

مرفق الملف

Database1.accdb

تم تعديل أغسطس 2, 2021 بواسطه qathi

[محمد أبوعبدالله]

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

قم بتحميل تطبيق google drive

https://www.google.com/drive/download/

قم بتحديد مجلد google drive في المكان الذي تريده

قم بعمل كود لانشاء نسخة احتياطية في حدث الاغلاق

If MsgBox("هل تريد اجراء نسخة احتياطية من البرنامج؟", _
    vbQuestion + vbYesNo, _
    "نسخة احتياطية") = vbYes Then

        On Error Resume Next
        
        Dim OldFile As String, DBwithEXT, DBwithoutEXT, NewFile As String, CopyMyDB
        
           Dim fs, cf, strFolder
                   strFolder = CurrentProject.Path & "\Backup"
            Set fs = CreateObject("Scripting.FileSystemObject")
                If fs.FolderExists(strFolder) = False Then
            Set cf = fs.CreateFolder(strFolder)

      End If
     
        OldFile = CurrentDb.Name
'	السطر التالي قم بتغييره الى مسار الحفظ الجديد
        StrNew = CurrentProject.Path & "\Backup"
        
        DBwithEXT = Dir(OldFile)
        DBwithoutEXT = Left(DBwithEXT, Len(DBwithEXT) - 6)
        If [BKUP] = True Then
        NewFile = StrNew & "\" & DBwithoutEXT & "-" & Format(Date, "yyyy-mm-dd") & "-" & Format(Now(), "Hh-Nn-Ss-AMPM") & Right(DBwithEXT, 6)
        CopyMyDB = "cmd.exe /C copy " & """" & OldFile & """" & " " & """" & NewFile & """"
        Shell CopyMyDB, 0
        Exit Sub
        End If

    End If

انتبه لتغيير المسار

تحياتي

 

تحياتي

[qathi]

On 8/3/2021 at 5:44 AM, محمد أبوعبدالله said:

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

وعليكم السلام أخي @محمد أبوعبدالله

شكرا على ردك ومرورك الطيب 

 

اذا كنت ساعتمد على طريقتك اخي أذاً أستسمحك أن نناقش نقاط طريقتك 

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

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

طبعا لا أخفيك أني حاولت مرارا ضبط الكود  .. حتى يتم حفظ نسخه الى داخل مجلد بسطح المكتب لكن دون جدوى 

 وقد اعتمدت على كود استدعاء مسار سطح المكتب الموجودة بالمنتدى 

'هذه الدالة تستخرج مسار سطح المكتب لديك
Function GetDesktop() As String
    Dim oWSHShell As Object
    Set oWSHShell = CreateObject("WScript.Shell")
    GetDesktop = oWSHShell.SpecialFolders("Desktop")
    Set oWSHShell = Nothing
End Function

 

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

علما ان مسار القاعة الخلفية  مع التنسيق كالتالي :

\DataBe\DataQa.DB

 

شاكرا لك تعاونك والجهد الذي تبذله

[qathi]

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

Private Sub R3_Click()
If MsgBox("åá ÊÑíÏ ÇÌÑÇÁ äÓÎÉ ÇÍÊíÇØíÉ ãä ÇáÈÑäÇãÌ¿", _
    vbQuestion + vbYesNo, _
    "äÓÎÉ ÇÍÊíÇØíÉ") = vbYes Then

        On Error Resume Next
    Dim fileName As String
        fileName = GetDesktop & "\" & "Backup" & ""
'        fileName = GetDesktop
        
        
        Dim OldFile As String, DBwithEXT, DBwithoutEXT, NewFile As String, CopyMyDB
        
           Dim fs, cf, strFolder
'                   strFolder = CurrentProject.Path & "\Backup"
                   strFolder = fileName
            Set fs = CreateObject("Scripting.FileSystemObject")
                If fs.FolderExists(strFolder) = False Then
            Set cf = fs.CreateFolder(strFolder)

      End If
     
'        OldFile = CurrentDb.Name
        OldFile = CurrentProject.Path & "\DataBe\Data.DB"

'   مسار حفظ النسخة
'        StrNew = CurrentProject.Path & "\Backup"
        StrNew = fileName
        DBwithEXT = Dir(OldFile)
        DBwithoutEXT = Left(DBwithEXT, Len(DBwithEXT) - 6)
        If [BKUP] = True Then
        NewFile = StrNew & "\" & DBwithoutEXT & "-" & Format(Date, "yyyy-mm-dd") & "-" & Format(Now(), "Hh-Nn-Ss-AMPM") & Right(DBwithEXT, 6)
        CopyMyDB = "cmd.exe /C copy " & """" & OldFile & """" & " " & """" & NewFile & """"
        Shell CopyMyDB, 0
        Exit Sub
        End If

    End If
End Sub

'هذه الدالة تستخرج مسار سطح المكتب لديك
Function GetDesktop() As String
    Dim oWSHShell As Object
    Set oWSHShell = CreateObject("WScript.Shell")
    GetDesktop = oWSHShell.SpecialFolders("Desktop")
    Set oWSHShell = Nothing
End Function

 

الكود يقوم بعمل نسخة في سطح المكتب داخل مجلد Backup

 

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

فياريت اجد حل يضع اسم القاعدة كما هو .. وبعد ذلك فرمات التاريخ والوقت وبعد ذلك الامتداد

الكود المسؤل عن هذا التالي:

NewFile = StrNew & "\" & DBwithoutEXT & "-" & Format(Date, "yyyy-mm-dd") & "-" & Format(Now(), "Hh-Nn-Ss-AMPM") & Right(DBwithEXT, 6)

 

شاكرا لكل من ساهم  و رد على الموضوع

تم تعديل أغسطس 4, 2021 بواسطه qathi

[محمد أبوعبدالله]

في ٤‏/٨‏/٢٠٢١ at 23:32, qathi said:

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

الحروف الستة هي امتداد الملف .accdb

وليست لها علاقة باسم الملف نفسه

لكنك تستخدم امتداد قاعدة البيانات .DB

OldFile = CurrentProject.Path & "\DataBe\Data.DB"

لذلك تحدث المشكلة

على كل حال ان كنت تسخدم قاعة بيانات بامتداد .accdb يكون عدد الحروف 6

واذا كانت .mdb يكون عدد الحروف 4

واذا كانت .DB يكون عدد الحروف 3

تحياتي