laccdb lock retained after Access is closed?

**margzj** · 07-18-2017, 03:14 AM

When I open the database it keeps repairing itself.

I also received this message when I try to close the ms access.
I am the only user.

Click image for larger version.

Name: 1.jpg
Views: 28
Size: 77.5 KB
ID: 29488

When I open the database.

Click image for larger version.

Name: 2.jpg
Views: 28
Size: 79.6 KB
ID: 29489

Please help here is my code.

frmAdd

Code:

Option Compare Database
Option Explicit
Private Sub btnAdd_Exit(Cancel As Integer)
Forms("frmMain").Requery
End Sub


Private Sub btnClose_Click()
On Error GoTo Err_Catch
    Me.Undo
    DoCmd.Close
btnClose_Click:
    Exit Sub
Err_Catch:
    MsgBox Err.Description
    Resume btnClose_Click
End Sub


Private Sub CatergoryInfo_ID_NotInList(NewData As String, Response As Integer)
On Error GoTo myError
    
    Dim rst As DAO.Recordset
        
    Set rst = CurrentDb.OpenRecordset("CatergoryInfo", dbOpenDynaset)
    
        If vbYes = MsgBox("Category is not in the list. Do you wish to add " _
                & NewData & " as a new Category?", _
                vbYesNo + vbInformation, _
                "New Category") Then
                
            rst.AddNew
                rst!Category = NewData
            rst.Update
            
            Response = acDataErrAdded
            
        Else
        
            Response = acDataErrContinue
            
        End If
       
leave:


    If Not rst Is Nothing Then
        rst.Close: Set rst = Nothing
    End If
    
    Exit Sub
    
myError:
   
    MsgBox "Error " & Err.Number & ": " & Error$
    Resume leave
End Sub




Private Sub CompanyInfo_ID_Change()
If IsNull(Me.CompanyInfo_ID.Value And Me.CountryInfo_ID.Value) Then
btnAdd.Enabled = False
Else
btnAdd.Enabled = True
End If
End Sub


Private Sub CompanyInfo_ID_LostFocus()
If IsNull(Me.CompanyInfo_ID.Value And Me.CountryInfo_ID.Value) Then
btnAdd.Enabled = False
Else
btnAdd.Enabled = True
End If
End Sub
Private Sub CountryInfo_ID_Change()
If IsNull(Me.CompanyInfo_ID.Value And Me.CountryInfo_ID.Value) Then
btnAdd.Enabled = False
Else
btnAdd.Enabled = True
End If
End Sub


Private Sub CountryInfo_ID_LostFocus()
If IsNull(Me.CompanyInfo_ID.Value And Me.CountryInfo_ID.Value) Then
btnAdd.Enabled = False
Else
btnAdd.Enabled = True
End If
End Sub


Private Sub CompanyInfo_ID_NotInList(NewData As String, Response As Integer)
On Error GoTo myError
    
    Dim rst As DAO.Recordset
        
    Set rst = CurrentDb.OpenRecordset("CompanyInfo", dbOpenDynaset)
    
        If vbYes = MsgBox("Company name is not in the list. Do you wish to add " _
                & NewData & " as a new Company?", _
                vbYesNo + vbInformation, _
                "New Company") Then
                
            rst.AddNew
                rst!CompanyName = NewData
            rst.Update
            
            Response = acDataErrAdded
            
        Else
        
            Response = acDataErrContinue
            
        End If
       
leave:


    If Not rst Is Nothing Then
        rst.Close: Set rst = Nothing
    End If
    
    Exit Sub
    
myError:
   
    MsgBox "Error " & Err.Number & ": " & Error$
    Resume leave
End Sub
Private Sub Email_AfterUpdate()
If IsNull(Me.Email.Value) Then
Me.cmbEmailStatus.Value = Null
Else
Me.cmbEmailStatus.Value = "NEW"
End If
End Sub


Private Sub Fax_BeforeUpdate(Cancel As Integer)
Dim rslt As Integer
 
   If Nz(DLookup("[Fax]", "ContactDetails", "[Fax]='" & Me.Fax & "'"), 0) <> 0 Then
      rslt = MsgBox("This number has already been entered. Do you wish to continue?", vbYesNo)
      If rslt = vbNo Then
         Cancel = True
         'Me.Fax = Null
         'Me.Fax.SetFocus
      End If
   End If
End Sub


Private Sub Form_Load()
DoCmd.GoToRecord , , acNewRec
End Sub


Private Sub Mobile_BeforeUpdate(Cancel As Integer)
Dim rslt As Integer
 
   If Nz(DLookup("[Mobile]", "ContactDetails", "[Mobile]='" & Me.Mobile & "'"), 0) <> 0 Then
      rslt = MsgBox("This number has already been entered. Do you wish to continue?", vbYesNo)
      If rslt = vbNo Then
         Cancel = True
         'Me.Mobile = Null
         'Me.Mobile.SetFocus
      End If
   End If
End Sub


Private Sub PositionInfo_ID_NotInList(NewData As String, Response As Integer)
On Error GoTo myError
    
    Dim rst As DAO.Recordset
        
    Set rst = CurrentDb.OpenRecordset("PositionInfo", dbOpenDynaset)
    
        If vbYes = MsgBox("Position is not in the list. Do you wish to add " _
                & NewData & " as a new Position?", _
                vbYesNo + vbInformation, _
                "New Position") Then
                
            rst.AddNew
                rst!Position = NewData
            rst.Update
            
            Response = acDataErrAdded
            
        Else
        
            Response = acDataErrContinue
            
        End If
       
leave:


    If Not rst Is Nothing Then
        rst.Close: Set rst = Nothing
    End If
    
    Exit Sub
    
myError:
   
    MsgBox "Error " & Err.Number & ": " & Error$
    Resume leave
End Sub


Private Sub Telephone_BeforeUpdate(Cancel As Integer)
Dim rslt As Integer
 
   If Nz(DLookup("[Telephone]", "ContactDetails", "[Telephone]='" & Me.Telephone & "'"), 0) <> 0 Then
      rslt = MsgBox("This number has already been entered. Do you wish to continue?", vbYesNo)
      If rslt = vbNo Then
         Cancel = True
         'Me.Telephone = Null
         'Me.Telephone.SetFocus
      End If
   End If
End Sub

frmMain

Code:

Option Compare Database
Option Explicit


Private Sub btnFind_Click()
DoCmd.RunCommand acCmdFind
End Sub


Private Sub btnReset_Click()


    Me.FilterOn = False
 
End Sub


Private Sub Form_Load()
'fMakeBackup
Application.SetOption "Default Find/Replace Behavior", 1
Me.FilterOn = False
End Sub

frmSearch

Code:

Option Compare Database
Private Sub btnClear_Click()
For Each ctl In Me.Controls
    Select Case ctl.ControlType
    Case acTextBox, acComboBox, acCheckBox ' adjust to taste
        'Debug.Print ctl.Name, Len(ctl.ControlSource)
        If Len(ctl.ControlSource) = 0 Then
            ctl.Value = Null
        End If
    Case Else
        ' pass
    End Select
Next
Forms("frmMain").FilterOn = False
End Sub


Private Sub btnClose_Click()
On Error GoTo Err_Catch
    DoCmd.Close
btnClose_Click:
    Exit Sub
Err_Catch:
    MsgBox Err.Description
    Resume btnClose_Click
End Sub


Private Sub btnSearch_Click()
If Not CurrentProject.AllForms("frmMain").IsLoaded Then
        DoCmd.OpenForm ("frmMain")
End If


'/////// PRIORITIES
If Not IsNull(Me.cmbPriorities) Then
    Forms("frmMain").Filter = "[Priorities] Like " & Chr(34) & "*" & Me.cmbPriorities & "*" & Chr(34)
    Forms("frmMain").FilterOn = True
End If
'/////// FOLLOWUP
If Not IsNull(Me.Followup) Then
    Forms("frmMain").Filter = "[Followup] = " & Me.Followup
    Forms("frmMain").FilterOn = True
End If
'/////// CLIENT
If Not IsNull(Me.Client) Then
    Forms("frmMain").Filter = "[Client] = " & Me.Client
    Forms("frmMain").FilterOn = True
End If
'/////// COMPANY
'If Not IsNull(Me.CompanyInfo_ID) Then
'    Forms("frmMain").Filter = "[CompanyInfo_ID] Like " & Chr(34) & "*" & Me.CompanyInfo_ID & "*" & Chr(34)
'   Forms("frmMain").FilterOn = True
'End If
'/////// CONTACT PERSON
If Not IsNull(Me.ContactPerson) Then
    Forms("frmMain").Filter = "[ContactPerson] Like " & Chr(34) & "*" & Me.ContactPerson & "*" & Chr(34)
    Forms("frmMain").FilterOn = True
End If
'/////// STATUS
If Not IsNull(Me.Status) Then
    Forms("frmMain").Filter = "[Status] = " & Chr(34) & Me.Status & Chr(34)
    Forms("frmMain").FilterOn = True
End If
'/////// EMAIL
If Not IsNull(Me.Email) Then
    Forms("frmMain").Filter = "[Email] Like " & Chr(34) & "*" & Me.Email & "*" & Chr(34)
    Forms("frmMain").FilterOn = True
End If
'/////// REMARKS
If Not IsNull(Me.Remarks) Then
    Forms("frmMain").Filter = "[Remarks] Like " & Chr(34) & "*" & Me.Remarks & "*" & Chr(34)
    Forms("frmMain").FilterOn = True
End If
'/////// CATEGORY
If Not IsNull(Me.CatergoryInfo_ID) Then
    Forms("frmMain").Filter = "[CatergoryInfo_ID] = " & Me.CatergoryInfo_ID
    Forms("frmMain").FilterOn = True
End If
'/////// CITY
If Not IsNull(Me.City) Then
    Forms("frmMain").Filter = "[Full Address] Like " & Chr(34) & "*" & Me.City & "*" & Chr(34)
    Forms("frmMain").FilterOn = True
End If
'/////// ADDRESS
If Not IsNull(Me.Address) Then
    Forms("frmMain").Filter = "[Full Address] Like " & Chr(34) & "*" & Me.Address & "*" & Chr(34)
    Forms("frmMain").FilterOn = True
End If
'/////// COUNTRY
If Not IsNull(Me.CountryInfo_ID) Then
    Forms("frmMain").Filter = "[CountryInfo_ID] = " & Me.CountryInfo_ID
    Forms("frmMain").FilterOn = True
End If
End Sub

frmUpdate

Code:

Option Compare Database
Option Explicit


Private Sub btnClose_Click()
On Error GoTo Err_Catch
    Me.Undo
    DoCmd.Close
btnClose_Click:
    Exit Sub
Err_Catch:
    MsgBox Err.Description
    Resume btnClose_Click
End Sub


Private Sub CatergoryInfo_ID_NotInList(NewData As String, Response As Integer)
On Error GoTo myError
    
    Dim rst As DAO.Recordset
        
    Set rst = CurrentDb.OpenRecordset("CatergoryInfo", dbOpenDynaset)
    
        If vbYes = MsgBox("Category is not in the list. Do you wish to add " _
                & NewData & " as a new Category?", _
                vbYesNo + vbInformation, _
                "New Category") Then
                
            rst.AddNew
                rst!Category = NewData
            rst.Update
            
            Response = acDataErrAdded
            
        Else
        
            Response = acDataErrContinue
            
        End If
       
leave:


    If Not rst Is Nothing Then
        rst.Close: Set rst = Nothing
    End If
    
    Exit Sub
    
myError:
   
    MsgBox "Error " & Err.Number & ": " & Error$
    Resume leave
End Sub


Private Sub CompanyInfo_ID_NotInList(NewData As String, Response As Integer)
On Error GoTo myError
    
    Dim rst As DAO.Recordset
        
    Set rst = CurrentDb.OpenRecordset("CompanyInfo", dbOpenDynaset)
    
        If vbYes = MsgBox("Company name is not in the list. Do you wish to add " _
                & NewData & " as a new Company?", _
                vbYesNo + vbInformation, _
                "New Company") Then
                
            rst.AddNew
                rst!CompanyName = NewData
            rst.Update
            
            Response = acDataErrAdded
            
        Else
        
            Response = acDataErrContinue
            
        End If
       
leave:


    If Not rst Is Nothing Then
        rst.Close: Set rst = Nothing
    End If
    
    Exit Sub
    
myError:
   
    MsgBox "Error " & Err.Number & ": " & Error$
    Resume leave
End Sub


Private Sub Email_AfterUpdate()
If IsNull(Me.Email.Value) Then
Me.cmbEmailStatus.Value = Null
Else
Me.cmbEmailStatus.Value = "NEW"
End If
End Sub


Private Sub PositionInfo_ID_NotInList(NewData As String, Response As Integer)
On Error GoTo myError
    
    Dim rst As DAO.Recordset
        
    Set rst = CurrentDb.OpenRecordset("PositionInfo", dbOpenDynaset)
    
        If vbYes = MsgBox("Position is not in the list. Do you wish to add " _
                & NewData & " as a new Position?", _
                vbYesNo + vbInformation, _
                "New Position") Then
                
            rst.AddNew
                rst!Position = NewData
            rst.Update
            
            Response = acDataErrAdded
            
        Else
        
            Response = acDataErrContinue
            
        End If
       
leave:


    If Not rst Is Nothing Then
        rst.Close: Set rst = Nothing
    End If
    
    Exit Sub
    
myError:
   
    MsgBox "Error " & Err.Number & ": " & Error$
    Resume leave
End Sub

**alansidman** · 07-18-2017, 03:23 AM

Sounds like you may have a corrupt DB. Open a new DB. Go to External Data, New Data Source, From DataBase, Access, Select your DataBase, Import, On each tab select All and then click ok. Your new db should be free of any corruption. Use the new DB and delete the Old one after testing to make sure it is viable.

**margzj** · 07-18-2017, 04:04 AM

Done, I will observe now and let you know.

thank you.

**margzj** · 07-18-2017, 04:37 AM

Still happening It usually occurs after I update some data.

Originally Posted by alansidman

Sounds like you may have a corrupt DB. Open a new DB. Go to External Data, New Data Source, From DataBase, Access, Select your DataBase, Import, On each tab select All and then click ok. Your new db should be free of any corruption. Use the new DB and delete the Old one after testing to make sure it is viable.

**margzj** · 07-18-2017, 11:27 PM

Bump, help anyone?

**June7** · 07-19-2017, 12:58 AM

If you want to provide db for analysis, follow instructions at bottom of my post.

**margzj** · 07-19-2017, 01:33 AM

Originally Posted by June7

If you want to provide db for analysis, follow instructions at bottom of my post.

Hi I already attached my ms access file. Thanks

**June7** · 07-19-2017, 01:46 AM

Opened db, added record into the form that opened, updated record, then close db. laccdb file gone

**margzj** · 07-19-2017, 01:52 AM

Originally Posted by June7

Opened db, added record into the form that opened, updated record, then close db. laccdb file gone

It's not always happening.

**June7** · 07-19-2017, 03:52 AM

I did data entry/edit several times. If you can't identify circumstances (sequence of operations, particular data input, etc) that cause issue then can't replicate and can't offer a solution.

**margzj** · 07-19-2017, 04:19 AM

Based on my observation It usually occurs when I am updating the database.

Originally Posted by June7

I did data entry/edit several times. If you can't identify circumstances (sequence of operations, particular data input, etc) that cause issue then can't replicate and can't offer a solution.

**alansidman** · 07-19-2017, 05:08 AM

Look at this link and maybe this will help-->http://www.everythingaccess.com/tuto...ase-corruption

**June7** · 07-19-2017, 11:13 AM

What do you mean by 'updating' - just editing a record? Did that. I could do data edits for forever and a day and still not encounter random issue. The db works. I cannot replicate issue.

**margzj** · 07-19-2017, 11:22 PM

Yes editing some records, maybe It has something to do with my records? because I just imported this one from an excel file.

Originally Posted by June7

What do you mean by 'updating' - just editing a record? Did that. I could do data edits for forever and a day and still not encounter random issue. The db works. I cannot replicate issue.

**Micron** · 07-20-2017, 10:29 AM

I've seen this before (though that doesn't mean I have the correct answer this time). It was sometimes because the network wasn't refreshing fast enough and sometimes because the user had permissions to create or edit but not delete. If they cannot delete, the lock file remains.

laccdb lock retained after Access is closed?

Thread Tools

laccdb lock retained after Access is closed?

Similar Threads

LACCDB file won't delete

Access application loses focus when form is closed.

Combo Box Rowsource not Retained on Transfer

*.laccdb file stuck

Form closed in VBA; opened in Access 2007; acts like closed?

Tags for this Thread

Posting Permissions