Public Sub comp(ByVal sdb As String, ByVal sDBtmp As String, Optional ByVal pass As String = "")
On Error GoTo r:
If con.State = 1 Then con.Close
If rs.State = 1 Then rs.Close
Dim oApp As Access.Application
Set oApp = New Access.Application
If Trim$(pass) = "" Then
Call oApp.DBEngine.CompactDatabase(sdb, sDBtmp)
'wait for the app to finish
DoEvents
'remove the uncompressed original
Kill sdb
'rename the compressed file to the original to restore for other functions
Name sDBtmp As sdb
Else
Call oApp.DBEngine.CompactDatabase(sdb, sDBtmp, dbLangGeneral, , ";pwd=" & sPASSWORD)
'wait for the app to finish
DoEvents
'remove the uncompressed original
Kill sdb
'rename the compressed file to the original to restore for other functions
Name sDBtmp As sdb
End If
MsgBox "تم الضغط بنجاح", vbInformation, "ضغط ملف"
Exit Sub
r:
MsgBox Err.Description, vbCritical, "ضغط ملف"
Err.Clear
End Sub