محتاج كود ضغط وإصلاح قاعدة بيانات Access 2010

كود :

  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 Button9_Click(sender As Object, e As EventArgs) Handles Button9.Click

        Dim source = "C:\aaaaaa\MyDb.accdb "

        Dim compact = "C:\aaaaaa\MyDbcom.accdb"



        RunCompactDatabase(source, compact, "123456789")

    End Sub





    Sub RunCompactDatabase(ByVal Sou As String, ByVal Com As String, ByVal Pass As String)

        Dim AccessDatabaseEngine As New Microsoft.Office.Interop.Access.Dao.DBEngine

        Dim source As String = Sou

        Dim compact As String = Com

        Dim MyPassword As String = Pass

        AccessDatabaseEngine.CompactDatabase(source, compact, ";pwd=" & MyPassword)

        MsgBox("The database was compacted successfully")

    End Sub