[Easy4ever]

استخدم هذا الإجراء في الضغط والإصلاح

PHP كود :

Public Sub CompactAccessDBT(ByVal connectionString As String, ByVal mdwfilename As String)

Try
 
Dim Engine = CreateObject("JRO.JetEngine")

Engine.CompactDatabase("provider=microsoft.ace.oledb.12.0;" & "Data Source=" & Application.StartupPath & "\td.accdb;" & "Jet OLEDB:Database Password=22403;" & _
"Jet OLEDB:Engine Type=5;", _
"provider=microsoft.ace.oledb.12.0;" & _
"Jet OLEDB:Database Password=22403;" & _
"Data Source=" & Application.StartupPath & "\td.accdb.tmp" & ";" & _
 "Jet OLEDB:Engine Type=5;")
 Dim FullPath As String = IO.Path.GetDirectoryName(Application.StartupPath & "\td.accdb")
IO.File.Delete(Application.StartupPath & "\td.accdb")
Dim filename As String = IO.Path.GetFileName(Application.StartupPath & "\td.accdb" & ".tmp")
Dim GetFileNameWithoutExtension As String = IO.Path.GetFileNameWithoutExtension(Application.StartupPath & "\td.accdb" & ".tmp")
FileSystem.Rename(Application.StartupPath & "\td.accdb" & ".tmp", FullPath & "\" & GetFileNameWithoutExtension) 

Catch ex As Exception

If InStr(ex.Message.ToUpper, "password".ToUpper) Or InStr(ex.Message.ToUpper, "password".ToUpper) Then
MsgBox("Password is invalid.", MsgBoxStyle.OkOnly + MsgBoxStyle.Critical, "Password Database")

ElseIf My.Computer.FileSystem.FileExists(Application.StartupPath & "\td.accdb") = False Then
MsgBox("Database Not found!", MsgBoxStyle.OkOnly + MsgBoxStyle.Critical, "Erorr")

Else
MsgBox("Pressure operation failed!, Be sure not to open the database from another source.", MsgBoxStyle.OkOnly + MsgBoxStyle.Critical, "Erorr")

End If
End Try
End Sub 


عدلت لك الإجراء بالمعطيات إللي كتبتها لنا وهي كتالي
اسم قاعدة البيانات td.accdb
كلمة السر 22403

بعد نسخ الإجراء
أكتب كود الأستدعاء ، ضع هذا الكود في زر ( ضغط وإصلاح ) حتى يستعدي الإجراء

PHP كود :

Call CompactAccessDBT(Nothing, Nothing)