File sharing lock count exceeded.

[mlrucci]

Good morning, I have a inconsistent error when trying to delete duplicates. I will occasionally get the error 3052 "File sharing lock count exceeded. Increase Max Locks per file registration entry. My table has only 22,000 record. The error is on line "Call.Delete"

Private Sub cmdDup_Click()Dim dbs          As DAO.Database
Dim strSQL       As String
Dim strTable     As String
Dim strField1    As String
Dim strField2    As String
Dim strField3    As String
Dim varLastVal1  As Variant
Dim varLastVal2  As Variant
Dim varLastVal3  As Variant
Set dbs = CurrentDb
strTable = "tblImportFM_PI"    ' table name
strField1 = "LOAN_NUM"           ' field name
strField2 = "MC_ORDER_ID"       
strField3 = "REC_DATE"         


strSQL = "SELECT * FROM [" & strTable & "] ORDER BY [" & strField1 & "], [" & strField2 & "], [" & strField3 & "]"
    Debug.Print strSQL
    With CurrentDb.OpenRecordset(strSQL, dbOpenDynaset)
        varLastVal1 = Null
        varLastVal2 = Null
        varLastVal3 = Null
        'For each record, check varLastVal1, varLastVal2, varLastVal3 against previous values in strField1, strField2, strField3
        'If same then this is a duplicate so can be removed
        Do Until .EOF
            If .Fields(strField1) = varLastVal1 And .Fields(strField2) = varLastVal2 And .Fields(strField3) = varLastVal3 Then
                Call .Delete
                Else
                    varLastVal1 = .Fields(strField1)
                    varLastVal2 = .Fields(strField2)
                    varLastVal3 = .Fields(strField3)
            End If
                Call .MoveNext
                Loop
    'Ending the 'With' releases the Recordset
    End With
    DoCmd.Close acForm, "frmImportFM_PI"
    DoCmd.OpenForm "frmImportFM_PI"
End Sub

I am at a loss on this one. Anyone?

[Gicu]

Maybe try this:

Private Sub cmdDup_Click()
Dim dbs          As DAO.Database
dim rst          as DAO.Recordset
Dim strSQL       As String
Dim strTable     As String
Dim strField1    As String
Dim strField2    As String
Dim strField3    As String
Dim varLastVal1  As Variant
Dim varLastVal2  As Variant
Dim varLastVal3  As Variant




strTable = "tblImportFM_PI"    ' table name
strField1 = "LOAN_NUM"           ' field name
strField2 = "MC_ORDER_ID"       
strField3 = "REC_DATE"         


Set dbs = CurrentDb
strSQL = "SELECT * FROM [" & strTable & "] ORDER BY [" & strField1 & "], [" & strField2 & "], [" & strField3 & "]"
Set rst=dbs.OpenRecordset(strSQL, dbOpenDynaset)
    Debug.Print strSQL
    With rst
        varLastVal1 = Null
        varLastVal2 = Null
        varLastVal3 = Null
        'For each record, check varLastVal1, varLastVal2, varLastVal3 against previous values in strField1, strField2, strField3
        'If same then this is a duplicate so can be removed
        Do Until .EOF
            If .Fields(strField1) = varLastVal1 And .Fields(strField2) = varLastVal2 And .Fields(strField3) = varLastVal3 Then
                     .Delete
                Else
                    varLastVal1 = .Fields(strField1)
                    varLastVal2 = .Fields(strField2)
                    varLastVal3 = .Fields(strField3)
            End If
            .MoveNext
        Loop
    'Ending the 'With' releases the Recordset
    End With
rst.close
Set rst=Nothing
Set dbs=Nothing


    DoCmd.Close acForm, "frmImportFM_PI"
    DoCmd.OpenForm "frmImportFM_PI"
End Sub

Cheers,

[mlrucci]

Gicu, thank you for your response. Unfortunately, this didn't solve the problem and am getting the same error. I am self taught with access and vba, I am trying to understand what you did or are trying to do. Would like to understand and grow. Appreciate your help

[moke123]

I believe you can increase the locks number with something like this.

DAO.DBEngine.SetOption dbmaxlocksperfile,20000

When your done set it back to 9,500.

[Gicu]

In your original code you declared the dbs variable but never used it.

Here is some info on using Currentdb.OpenRecordset vs. dbs.OpenRecordset:
https://sourcedaddy.com/ms-access/th...-function.html
http://www.mendipdatasystems.co.uk/s...s-2/4594428908

And about using the (default) .Fields collection:
https://stackoverflow.com/questions/...ecordset-field

I revised the code a bit to match the data types of the three fields, you might want to try this version:

Private Sub cmdDup_Click()
Dim dbs          As DAO.Database
dim rst          as DAO.Recordset
Dim strSQL       As String
Dim strTable     As String
Dim strField1    As String
Dim strField2    As String
Dim strField3    As String
Dim varLastVal1  As Variant
Dim lngLastVal2  As Long
Dim dteLastVal3  As Date




strTable = "tblImportFM_PI"    ' table name
strField1 = "LOAN_NUM"           ' field name
strField2 = "MC_ORDER_ID"       
strField3 = "REC_DATE"         




Set dbs = CurrentDb
strSQL = "SELECT * FROM [" & strTable & "] ORDER BY [" & strField1 & "], [" & strField2 & "], [" & strField3 & "]"
Set rst=dbs.OpenRecordset(strSQL, dbOpenDynaset)
    Debug.Print strSQL
    With rst
        'varLastVal1 = Null
        'lngLastVal2 = Null
        'dteLastVal3 = Null
        'For each record, check varLastVal1, varLastVal2, varLastVal3 against previous values in strField1, strField2, strField3
        'If same then this is a duplicate so can be removed
        Do Until rst.EOF
            If !LOAN_NUM = varLastVal1 And !MC_ORDER_ID = lngLastVal2 And !REC_DATE = dteLastVal3 Then
                     .Delete
                Else
                    varLastVal1 = !LOAN_NUM
                    lngLastVal2 = !MC_ORDER_ID
                    dteLastVal3 = !REC_DATE
            End If
            .MoveNext
        Loop
    'Ending the 'With' releases the Recordset
    End With
rst.close
Set rst=Nothing
Set dbs=Nothing




    DoCmd.Close acForm, "frmImportFM_PI"
    DoCmd.OpenForm "frmImportFM_PI"
End Sub

And finally here is an alternative way to do it:
https://stackoverflow.com/questions/...at-9k-of-1m-re

Cheers,
Vlad