COMPACT AND REPAIR ACCESS 2007

[ahmeddc]

HI

The two functions used to compress and repair the database but the error occurs

1- Microsoft Jet and Replication Objects 2.6 Library

2- Microsoft.Office.Interop.Access.Dao


Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click
EndMD = ""
Access_2007(TextBoxBrowse.Text, "PASSWORD")
''
' Access7(TextBoxBrowse.Text, "E:\DATA.accdb")
If EndMD = "Successfully" Then
LAB_RESULTCOPY.Text = "Successfully"
ElseIf EndMD = "Database" Then
LAB_RESULTCOPY.Text = "Database FAILED"
ElseIf EndMD = "Failed" Then
LAB_RESULTCOPY.Text = " FAILED "
End If

End Sub



Public EndMD As String
Function Access7(ByVal FileNameMD As String, ByVal FileNameMDANOTH As String)
Try

Dim AccessEngine As New Microsoft.Office.Interop.Access.Dao.DBEngine
AccessEngine.CompactDatabase(FileNameMD, FileNameMDANOTH)
AccessEngine = Nothing
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


Function Access_2007(ByVal FileNameMD As String, ByVal PasswordMD As String)

Try

Dim Engine = CreateObject("JRO.JetEngine")
Engine.CompactDatabase("provider=microsoft.ace.oledb.12.0;" & "Data Source=" & FileNameMD & ";" & "Jet OLEDBatabase Password=" & PasswordMD & ";" & _
"Jet OLEDB:Engine Type=5;", _
"provider=microsoft.ace.oledb.12.0;" & _
"Jet OLEDBatabase 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

Continue reading...