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

VB Code:

vBackup = "Data Source=" & App.Path & "\BackUp"

i think u miss the .mdb

VB Code:

vBackup = "Data Source=" & App.Path & "\BackUp.mdb"

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

Be sure that you have closed all of your connections to the database before trying to compact.

Also, if you are using the data environment you will need to shut down the program in order to do the compaction. I have this latter problem and due to the lateness of the compaction design request I have had to do a calling program that does the compaction prior to my app running.

No fun at all.

:cool:

that's true...now i need to close all my adodc connections..same as the dataenvironment...tell me how can i close the dataenvironments connection? and also, how can i detect whether if there's an existing ado connection open? i have numerous adodc's on my system and i need to close it all upon form unload....


hi sir deepak, your code works ! thanks for that!...and erick that also do the trick, but i decided to adopt sir deepak's code ..thanks anyway! :D
:thumb:

Code:

---

Public Function compactDB(ByVal SOUR_path As String, _
  ByVal DEST_path As String) As Boolean
 
  On Error GoTo Err_compact
 Dim JRO As New JRO.JetEngine

' Source and Destination connection path
  Dim 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"
 
    MsgBox DB_sour
    MsgBox DB_dest
    JRO.CompactDatabase DB_sour, DB_dest
   
    Kill SOUR_path
    Name DEST_path As SOUR_path
    MsgBox "Your database was successfully compacted and repaired", vbInformation + vbOKOnly, "SUCCESSFUL"

  compactDB = True
  Exit Function
 
Err_compact:
  compactDB = False
  MsgBox Err.Description, vbExclamation
End Function

---

repeating my question :

is there a way to close the adodc connection control?? i can only close the recordset adodc1.recordset.close, but what about the connection?? is there a way to close all connection before compacting the database? ..

thanks for the help guys :thumb:

just another question..can i specify the path of the back up database when i run the program? i mean i want to browse for my selected folder where i can save my compacted or backup database...

u can specify the path of the back up database in DEST_path variable.

EDIT:
umm wait... do u want browse for folder code ?

yes, i want to browse for folder location...

VB Code:

Private Type BrowseInfo
    hWndOwner As Long
    pIDLRoot As Long
    pszDisplayName As Long
    lpszTitle As Long
    ulFlags As Long
    lpfnCallback As Long
    lParam As Long
    iImage As Long
End Type
Const BIF_RETURNONLYFSDIRS = 1
Const MAX_PATH = 260
Private Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal hMem As Long)
Private Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" (ByVal lpString1 As String, ByVal lpString2 As String) As Long
Private Declare Function SHBrowseForFolder Lib "shell32" (lpbi As BrowseInfo) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pidList As Long, ByVal lpBuffer As String) As Long
 
Private Sub Form_Load()
    Dim iNull As Integer, lpIDList As Long, lResult As Long
    Dim sPath As String, udtBI As BrowseInfo
 
    With udtBI
        'Set the owner window
        .hWndOwner = Me.hwnd
        'lstrcat appends the two strings and returns the memory address
        .lpszTitle = lstrcat("C:\", "")
        'Return only if the user selected a directory
        .ulFlags = BIF_RETURNONLYFSDIRS
    End With
 
    'Show the 'Browse for folder' dialog
    lpIDList = SHBrowseForFolder(udtBI)
    If lpIDList Then
        sPath = String$(MAX_PATH, 0)
        'Get the path from the IDList
        SHGetPathFromIDList lpIDList, sPath
        'free the block of memory
        CoTaskMemFree lpIDList
        iNull = InStr(sPath, vbNullChar)
        If iNull Then
            sPath = Left$(sPath, iNull - 1)
        End If
    End If
 
    If Len(Trim(sPath)) > 0 Then MsgBox sPath
End Sub

pretty complicated...cant i just use a dialog box??

CCRP They have controls like BrowseDialog, FolderTreeview.

thanks sir, ill check that out...for the meantime ill just have to do some tweaking on ur provided codes...ill inform you of what i've done..;)