runtime error in compacting access database
i tried compacting my database using this code i got here :
Code:
Private Sub cmdRepair_Click()
Dim vJet As New JRO.JetEngine
Dim vBak As String
Dim vBackup As String
Dim vSource As String
vBak = Left(App.Path & "DB.mdb", InStr(App.Path & "DB.mdb", ".")) & "bak"
If CBool(Len(Dir(vBak))) Then Kill vBak
vSource = "Data Source=" & App.Path & "\DB.mdb"
vBackup = "Data Source=" & App.Path & "\BackUp"
vJet.CompactDatabase vSource, vBackup
Kill App.Path & "DB.mdb"
Name vBak As App.Path & "DB.mdb"
MsgBox "Your database was successfully compacted and repaired", vbInformation + vbOKOnly, "SUCCESSFUL"
End Sub
but it produce the following error
Runtime error '2147217911'
the microsoft jet database engine cannot open the file 'E:\AMSystem\bahay\BackUp'.it is already opened exclusivley by another user , or you need permission to view its data..
and it is pointing to this code
vJet.CompactDatabase vSource, vBackup
my system location is at E:\AMSystem\bahay\
can anybody tell me what is wrong?? i already close the database when i runt this code but i still get this error
this is how we compact access database
VB Code:
'**********************************************************
'Passing values compactDB module
'Sour_path = Source path of existing database.
'Dest_Path = Target path
'
'Note -
'Add Microsoft Jet and Replication Objects X.X library,
'where (X.X is greater than or equal to 2.1).
'***********************************************************
'Jet OLEDB:Engine Type Jet x.x Format MDB Files
'********************* ************************
' 1 JET10
' 2 JET11
' 3 JET2X
' 4 JET3X
' 5 JET4X
'**********************************************************
Option Explicit
Public Function compactDB(ByVal SOUR_path As String, _
ByVal DEST_path As String) As Boolean
On Error GoTo Err_compact
Private JRO As New JRO.JetEngine
' Source and Destination connection path
Private DB_sour As String, DB_dest As String
DoEvents
DB_sour = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" _
& SOUR_path
DB_dest = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" _
& DEST_path & " ;Jet OLEDB:Engine Type=5"
JRO.CompactDatabase DB_sour, DB_dest
compactDB = True
Exit Function
Err_compact:
compactDB = False
MsgBox Err.Description, vbExclamation
End Function
'*************************************************
' Usage Module level or form level.
'*************************************************
' Dim source_path,Target_path as string
' source_path=App.Path & "\Nwind.MDB"
' Target_path=App.Path & "\CompactNwind.MDB"
' If not compactDB(source_path,Target_path) Then
' MsgBox "An error occurred while attempt to rename database " _
' & vbCrLf & vbCrLf & DBCP_Name, vbExclamation
' End If