[princelovelorn]

السلام عليكم ورحمة الله وبركاته
محتاج كود ضغط وإصلاح قاعدة بيانات Access 2007 & 2010  
الكود التالى يعمل ولكن يحولها ل 2003

كود :

  Dim DbasePath2007 As String = "C:\aaaaaa\MyDB.accdb"

   'إجراء ضغط وإصلاح لقاعدة بيانات أكسس 2007
   Function Access_2007(ByVal FileNameMD As String, ByVal PasswordMD As String)
       con.Close()
       Try

           Dim AccessDatabaseEngine As New Microsoft.Office.Interop.Access.Dao.DBEngine
           Dim Engine = CreateObject("JRO.JetEngine")
           Engine.CompactDatabase("provider=microsoft.ace.oledb.12.0;" & "Data Source=" & FileNameMD & ";" & "Jet OLEDB:Database Password=" & PasswordMD & ";" & _
           "Jet OLEDB:Engine Type=5;", _
           "provider=microsoft.ace.oledb.12.0;" & _
           "Jet OLEDB:Database Password=" & PasswordMD & ";" & _
           "Data Source=" & FileNameMD & ".tmp" & ";" & _
            "Jet OLEDB:Engine Type=5;")
           Dim FullPath As String = IO.Path.GetDirectoryName(FileNameMD)
           IO.File.Delete(FileNameMD)
           Dim filename As String = IO.Path.GetFileName(FileNameMD & ".tmp")
           Dim GetFileNameWithoutExtension As String = IO.Path.GetFileNameWithoutExtension(FileNameMD & ".tmp")
           FileSystem.Rename(FileNameMD & ".tmp", FullPath & "\" & GetFileNameWithoutExtension)
           EndMD = "Successfully"
           Return EndMD ' إرجع بقيمة تدل على إكمال العملية بنجاح
       Catch ex As Exception
           If My.Computer.FileSystem.FileExists(FileNameMD) = False Then
               EndMD = "Database"
               Return EndMD ' إرجع بقيمة تدل على فشل العملية بسبب عدم صحة مسار قاعدة البيانات
           Else
               EndMD = "Failed"
               Return EndMD ' إرجع بقيمة تدل على فشل العملية لاسباب اخرى
           End If
       End Try
   End Function


   'إجراء ضغط وإصلاح لقاعدة بيانات أكسس 2007

   'يوضع في زر للتنفيذ الدالة الأجراء الاتي '
   Private Sub Compactdba()
       Try
           Access_2007(DbasePath2007, "123456789")
       Catch ex As Exception
           MessageBox.Show(ex.Message, "Error", MessageBoxButtons.OK, MessageBoxIcon.Error)
       End Try
       Try
           '-----------------------------------------------------------
           EndMD = ""
           Access_2007(DbasePath2007, "123456789")
           ''                                 ''
           If EndMD = "Successfully" Then
               MsgBox("تمت عملية ضغط وإصلاح قاعدة البيانات بنجاح", MsgBoxStyle.Exclamation, "صيانة قاعدة البيانات")
           ElseIf EndMD = "Database" Then
               MsgBox(" قاعدة البيانات غير موجودة!", MsgBoxStyle.OkOnly + MsgBoxStyle.Critical, "Not found")

           ElseIf EndMD = "Failed" Then
               MsgBox("فشل العملية .", MsgBoxStyle.OkOnly + MsgBoxStyle.Critical, "Erorr")
           End If
           ''=================================================================
       Catch ex As Exception
           MessageBox.Show(ex.Message, "Error", MessageBoxButtons.OK, MessageBoxIcon.Error)
       End Try


   End Sub

الكود التالي يعمل ولكن لم أستطيع تمرير كلمة مرور القاعدة

كود :

Private Sub Compactdb()

       Dim AccessDatabaseEngine As New Microsoft.Office.Interop.Access.Dao.DBEngine
       Dim source = "C:\aaaaaa\MyDB.accdb "
       Dim compact = "C:\aaaaaa\MyDBCom.accdb"
       AccessDatabaseEngine.CompactDatabase(source, compact)
   
       MsgBox("The database was compacted successfully")

   End Sub

الرجاء التصحيح لما سبق أو  الكود الصحيح 
وجزاكم الله خيرا