أريد كود استبدال القاعدة القديمة بالجديدة

[ابو محمد العراقي]

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

ارجو من الاخوة المشرفين والاعضاء الذين لهم خبرة في مجال (الكودات) التفضل باضافة جمل الى الكود ادناه بحيث يتم حذف قاعدة البيانات الموجود في العنون (f:/IJ/) واستكمال الكود

اي بختصار (عندي قاعدة بيانات عندما اعمل نسخة احتياطية(اي بتفيذ الكود ادناه) يعمل هذا الكو على ازالة (قاعدة البيانات الموجودة في الموقع الي اسمها "مشروع 1" ((النسخة الاحتياطية القديمة)) ) واستبدالها بالقاعدة الجديدة

وعندي سوال ثاني اذ امكن قاعدة البيانات اصبحت كبيرة جدا بسب"OLE FILE" فما الحل

[

Function fMakeBackup1() As Boolean[align=left][/align
Dim strMsg As String
Dim tshFileOp As SHFILEOPSTRUCT
Dim lngRet As Long
Dim strSaveFile As String
Dim lngFlags As Long
Dim FolderToCopy
Const cERR_USER_CANCEL = vbObjectError + 1
Const cERR_DB_EXCLUSIVE = vbObjectError + 2 On Local Error GoTo fMakeBackup1_Err

    If fDBExclusive = True Then Err.Raise cERR_DB_EXCLUSIVE
    lngFlags = FOF_SIMPLEPROGRESS Or _
                            FOF_FILESONLY Or _
                            FOF_RENAMEONCOLLISION
    strSaveFile = "IJ PRO10.MBD"
    With tshFileOp
        .wFunc = FO_COPY
        .hwnd = hWndAccessApp
        .pFrom = CurrentDb.Name
        FolderToCopy = "F:\IJ\"

        If Len(FolderToCopy & "") = 1 Then
        Exit Function
        Else
        .pTo = FolderToCopy
        End If
        .fFlags = lngFlags
    End With
    lngRet = apiSHFileOperation(tshFileOp)
    fMakeBackup1 = (lngRet = 0)
    Ap_CheckDataBasePropertiesUpdate "Patch", FolderToCopy
    Ap_CheckDataBasePropertiesUpdate "DataBaseName", CurrentProject.Name
fMakeBackup1_End:
    Exit Function
fMakeBackup1_Err:
    fMakeBackup1 = False
    Select Case Err.Number
        Case cERR_USER_CANCEL:
            'do nothing
        Case cERR_DB_EXCLUSIVE:
            MsgBox "The current database " & vbCrLf & CurrentDb.Name & vbCrLf & _
                    vbCrLf & "is opened exclusively.  Please reopen in shared mode" & _
                    " and try again.", vbCritical + vbOKOnly, "Database copy failed"
        Case Else:
            strMsg = "Error Information..." & vbCrLf & vbCrLf
            strMsg = strMsg & "Function: fMakeBackup" & vbCrLf
            strMsg = strMsg & "Description: " & Err.Description & vbCrLf
            strMsg = strMsg & "Error #: " & Format$(Err.Number) & vbCrLf
            MsgBox strMsg, vbInformation, "fMakeBackup"
    End Select
    Resume fMakeBackup1_End

End Function

تم تعديل يناير 31, 2006 بواسطه ابو محمد العراقي

[Alhaithm]

أخي العزيز

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

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

إن راقتك فكرتي أرفق لك نموذج متكامل للفكرة.

http://www.alhaithm.com/Test.rar