Follow up a SQL query with a DB compact/repair???

I am trying to write a small .exe that will run a query on a DB, then run a compact and repair on that DB plus the other DBs in the same folder.

I get the error:
MS Jet engine stopped the process becuase you and another user are attempting to change the same data at the same time.


Option Explicit
Public DBList As String
Public strDBName As String
Public strNewDBName As String

Private Sub ListTables(ByVal db_name As String)
Dim statement As String
Dim conn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim lRecords
    Set conn = New ADODB.Connection
    conn.ConnectionString = _
        "Provider=Microsoft.Jet.OLEDB.4.0;" & _
        "Persist Security Info = False;" & _
        "Data Source=C:\Program Files\Helios11\Data\Link.mdb"
    'On Error Resume Next
    Set rs = conn.OpenSchema(adSchemaTables, _
        Array(Empty, Empty, Empty, "Table"))
        conn.Execute "delete * from transactions where client_no not in (select client_no from client_profile)", lRecords
    cmdRun.Visible = False
    lblRun.Caption = "Cleanup Complete!"
    Label1.Caption = lRecords
    cmdClose.Visible = True
    Call DBRepair
End Sub

Private Sub cmdClose_Click()
Unload Me
End Sub

Private Sub cmdRun_Click()
cmdRun.Enabled = False
Call ListTables("Link.mdb")

End Sub

Private Sub Form_Load()
Dim Index

cmdClose.Visible = False

DBList = Dir("C:\Program Files\Helios11\Data\*.mdb") ' this will list all the files in current path.

ListBox.Enabled = False

Do Until DBList = ""

ListBox.AddItem DBList

DBList = Dir


lbl1.Caption = ListBox.List(0)
lbl2.Caption = ListBox.ListCount
End Sub

Private Sub DBRepair()
Dim JRO As JRO.JetEngine
Dim FSO As New FileSystemObject
Dim Index As Integer
Dim Count As Integer

On Error Resume Next
Kill "C:\Program Files\Helios11\*.mdb"
If Err = 53 Then
End If

Index = 0
Count = ListBox.ListCount

For Index = 0 To ListBox.ListCount - 1

lbl1.Caption = ListBox.List(Index)
lbl2.Caption = Count


Set JRO = New JRO.JetEngine

strDBName = "C:\Program Files\Helios11\Data\" & ListBox.List(Index)
strNewDBName = "C:\Program Files\Helios11\" & ListBox.List(Index)
        JRO.CompactDatabase "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strDBName & "", _
        "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strNewDBName & ";Jet OLEDB:Engine Type=5"

        Set JRO = Nothing
        Count = Count - 1
        lbl1.Caption = "Done"
        lbl2.Caption = "Done"
        FSO.CopyFile "C:\Program Files\Helios11\*.mdb", "C:\Program Files\Helios11\Data", True

        Set FSO = Nothing
        Kill "C:\Program Files\Helios11\*.mdb"
        MsgBox "All Databases Successfully Compacted and Repaired!", vbOKOnly, "Operation Complete"
        Unload Me
End Sub

Who is Participating?
fullcontactConnect With a Mentor Commented:
Check for .ldb files in your dbrepair routine.

May need to delay until the .ldb files have cleared before trying to repair.
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.