[Okta Webinar] Learn how to a build a cloud-first strategyRegister Now

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 168
  • Last Modified:

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.

CODE:

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"
    conn.Open
   
    '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
    rs.Close
         
    conn.Close
     
    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

Loop

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

frmUpdate.Refresh

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
Next
               
        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

TIA,
Andrew
0
Ahelbling
Asked:
Ahelbling
1 Solution
 
fullcontactCommented:
Check for .ldb files in your dbrepair routine.

May need to delay until the .ldb files have cleared before trying to repair.
0

Featured Post

Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Tackle projects and never again get stuck behind a technical roadblock.
Join Now