Solved

Error 3734

Posted on 2014-02-04
1
433 Views
Last Modified: 2014-02-08
I've written and distributed many multi user Access DB's but never run into this issue.

3734 The database has been placed in a state by user 'Admin' on machine 'GRBXA2' that prevents it form being opened or locked.  When I researched the error it seemed to be referenced in a situation with a single MDB.  My MDB's are split

Data is on a server, each user has an install on their local machine.

MDB is compiled into an MDE and packaged for distribution using Sagekey.  There are users connecting to the DB remotely thru Cirix as well as users connecting on the in-office network where the server is located.

I'm pretty sure the GRBXa2 machine is connecting thru Citrix.

This is the code that is executing when the error is thrown.  Nothing out of the ordinary just a standard loop that happens to be writing records form a local table to a database table on the server.

The error was encountered in 'ProcessEnteredFees' after 20 or so records had been written.  The handler did not give a specific line, only the subroutine name.

Public Sub processEnteredFees()
'
' This is called from the batch fee entry program.  All the entered and validated fees ar in table
' 'tblTaxRecs_Fees_BatchEntry_Local'
'
' A tax header may be need to be created and the fee record be written for each entered fee.
'
Dim recCount As Long
'- - - - - - - - - - - - - - - - - - - - - - - - - - G E N E R A T E D  E R R O R  C O D E ----------------
'                      
                               If IsDeveloper Then
                               Else
                                 On Error GoTo processEnteredFees_Error
                               End If
'- - - - - - - - - - - - - - - - - - - - - - - - - - G E N E R A T E D  E R R O R  C O D E ----------------

recCount = 0
'
Dim passedBRT As Long
Dim passedUser As String
Dim passedComment As String
Dim passedSourceID As Long
Dim passedPeriod As Long
Dim passedRecordDate As Date
Dim passedPrincipalAmt As Double
Dim passedPenaltyAmt As Double
Dim passedInterestAmt As Double
Dim passedLienAmt As Double
Dim passedAttyFeeAmt As Double
Dim passedFeeAmt As Double
Dim passedFeeID As Long
Dim returnPropertyRecID As Long
Dim returnTaxRecID As Long
'
Dim returnOldestYearOwed As Long
'
DoCmd.Hourglass True
'
Dim rsIn As ADODB.Recordset
Set rsIn = New ADODB.Recordset
rsIn.Open "tblTaxRecs_Fees_BatchEntry_Local", CurrentProject.Connection, adOpenKeyset, adLockOptimistic
'
'///////////////////////////////////////
If rsIn.EOF Then
    Exit Sub
Else
    If rsIn.RecordCount > 0 Then
        '
        rsIn.MoveFirst
        While Not rsIn.EOF
            '
            passedBRT = Nz(rsIn!BRT, 0)
            passedUser = GimmeUserName
            passedComment = "Batch Manual Fee Add " & Nz(rsIn!Comment, "")
            passedSourceID = 3    ' manual
            '
            passedPeriod = Round((rsIn!FeePeriod * 10000) + 101, 2)            ' fee period is really just year being passed
            passedRecordDate = rsIn!FeeDate
            passedPrincipalAmt = 0
            passedPenaltyAmt = 0
            passedInterestAmt = 0
            passedLienAmt = 0
            passedAttyFeeAmt = 0
            passedFeeAmt = Nz(rsIn!OriginalAmt, 0)
            passedFeeID = Nz(rsIn!FeeID, 0)
            returnPropertyRecID = 0
            returnTaxRecID = 0
            '
            createUnfoundTaxRecAndPropRecIfNeeded passedBRT, _
                                                  passedUser, _
                                                  passedComment, _
                                                  passedSourceID, _
                                                  passedPeriod, _
                                                  passedRecordDate, _
                                                  passedPrincipalAmt, _
                                                  passedPenaltyAmt, _
                                                  passedInterestAmt, _
                                                  passedLienAmt, _
                                                  passedAttyFeeAmt, _
                                                  passedFeeAmt, _
                                                  passedFeeID, _
                                                  returnPropertyRecID, _
                                                  returnTaxRecID
            
            '
            synchTaxHeader_wDetailRecs passedBRT
            '
            recCount = recCount + 1
            '
            rsIn.MoveNext
        Wend
    End If
End If
'
rsIn.Close
Set rsIn = Nothing
'
'
DoCmd.Hourglass False
'
MsgBox Trim(Str(recCount)) & " fee records were created."
'

'- - - - - - - - - - - - - - - - - - - - - - - - - - G E N E R A T E D  E R R O R  C O D E ----------------
                               On Error GoTo 0
                               Exit Sub
processEnteredFees_Error:
                               sysErrorHandler Err.Number, Err.Description, "processEnteredFees", "modBatchFeeProcessing", "Module"
'- - - - - - - - - - - - - - - - - - - - - - - - - - G E N E R A T E D  E R R O R  C O D E ----------------


End Sub
Public Sub createUnfoundTaxRecAndPropRecIfNeeded(passedBRT As Long, _
                                                 passedUser As String, _
                                                 passedComment As String, _
                                                 passedSourceID As Long, _
                                                 passedPeriod As Long, _
                                                 passedRecordDate As Date, _
                                                 passedPrincipalAmt As Double, _
                                                 passedPenaltyAmt As Double, _
                                                 passedInterestAmt As Double, _
                                                 passedLienAmt As Double, _
                                                 passedAttyFeeAmt As Double, _
                                                 passedFeeAmt As Double, _
                                                 passedFeeID As Long, _
                                                 returnPropertyRecID As Long, _
                                                 returnTaxRecID As Long)
                                                 
'
Dim wkPropID As Long
'
Dim wkTaxHdrID As Long
Dim wkLast4OfPassedPeriod As String

Dim wkDate As Date
'- - - - - - - - - - - - - - - - - - - - - - - - - - G E N E R A T E D  E R R O R  C O D E ----------------
'                      
                               If IsDeveloper Then
                               Else
                                 On Error GoTo createUnfoundTaxRecAndPropRecIfNeeded_Error
                               End If
'- - - - - - - - - - - - - - - - - - - - - - - - - - G E N E R A T E D  E R R O R  C O D E ----------------

wkDate = Date

Dim wkAddTime As Date
wkAddTime = Now()
Dim wkUser As String
wkUser = passedUser
'
' Get propertyID, the called routine adds a new one if one doesn't exist for this brt
'
wkPropID = getPropertyIDFromBRT_ExistingOrAddNewOne(passedBRT, _
                                                    wkUser, _
                                                    wkAddTime, _
                                                    passedSourceID)
returnPropertyRecID = wkPropID
'
' Called routine either gets the existing tax headerID or creates a new header if one does not exist
'
wkTaxHdrID = getTaxHeaderID(passedBRT, _
                            wkPropID, _
                            passedPrincipalAmt, _
                            passedPenaltyAmt, _
                            passedInterestAmt, _
                            passedLienAmt, _
                            passedAttyFeeAmt, _
                            passedFeeAmt, _
                            wkUser, _
                            wkAddTime)

'
' Add a tax rec or a fee rec depending on the passed period
'
wkLast4OfPassedPeriod = Mid(Trim(Str(passedPeriod)), 5)

If wkLast4OfPassedPeriod = "1231" Then
    '
    Dim rsTax As ADODB.Recordset
    Set rsTax = New ADODB.Recordset
    rsTax.Open "tblTaxRecs", CurrentProject.Connection, adOpenKeyset, adLockOptimistic
    '
    rsTax.AddNew
        '
        rsTax!TaxHeaderID = wkTaxHdrID
        rsTax!PropertyID = wkPropID
        rsTax!BRT = passedBRT
        rsTax!TaxYear = Val(Mid(Trim(Str(passedPeriod)), 1, 4))
        rsTax!PrincipalAmt = passedPrincipalAmt
        rsTax!PenaltyAmt = passedPenaltyAmt
        rsTax!InterestAmt = passedInterestAmt
        rsTax!LienCost = passedLienAmt
        rsTax!AttyFeesAmt = passedAttyFeeAmt
        rsTax!EligExpAmt = passedFeeAmt
        rsTax!DateOfNumbers = Date
        rsTax!PayStausID = ePayStatus.eUnpaid
        
        rsTax!COPStatusID = 1   ' active
        rsTax!SynchProcessingID = 3    ' SynchOrDPAdd
        rsTax!Active_YN = cYesNum
        rsTax!Comment = passedComment
        rsTax!DateAdded = wkAddTime
        rsTax!UserAdded = wkUser
        '
    rsTax.Update
    '
    returnTaxRecID = rsTax!ID
    '
    rsTax.Close
    Set rsTax = Nothing
Else
    Dim rsFee As ADODB.Recordset
    Set rsFee = New ADODB.Recordset
    rsFee.Open "tblTaxRecs_Fees", CurrentProject.Connection, adOpenKeyset, adLockOptimistic
    '
    rsFee.AddNew
        '
        rsFee!TaxHdrID = wkTaxHdrID
        rsFee!BRT = passedBRT
        rsFee!FeePeriod = passedPeriod
        rsFee!FeeID = passedFeeID              ' revised to pass fee id for batch fee entry GetFeeIDFromCOPDesc(passedFeeDesc)
        rsFee!OriginalAmt = passedFeeAmt
        rsFee!CurrBalanceAmt = passedFeeAmt
        rsFee!FeeDate = passedRecordDate
        
        rsFee!PaymentStatusID = ePayStatus.eUnpaid
        rsFee!Comment = passedComment
        rsFee!COPStatusID = 1   ' active
        rsFee!SynchProcessingID = 3  ' SynchOrDPAdd
        
        rsFee!Active_YN = cYesNum
        rsFee!SourceID = passedSourceID
        rsFee!DateAdded = wkAddTime
        rsFee!UserAdded = wkUser
    rsFee.Update
    '
    returnTaxRecID = rsFee!ID
    '
    rsFee.Close
    Set rsFee = Nothing
End If
'

'- - - - - - - - - - - - - - - - - - - - - - - - - - G E N E R A T E D  E R R O R  C O D E ----------------
                               On Error GoTo 0
                               Exit Sub
createUnfoundTaxRecAndPropRecIfNeeded_Error:
                               sysErrorHandler Err.Number, Err.Description, "createUnfoundTaxRecAndPropRecIfNeeded", "modEvent_Import_Export_Comments", "Module"
'- - - - - - - - - - - - - - - - - - - - - - - - - - G E N E R A T E D  E R R O R  C O D E ----------------


End Sub
Public Function getPropertyIDFromBRT_ExistingOrAddNewOne(passedBRT As Long, _
                                                        passedUser As String, _
                                                        passedAddTime As Date, _
                                                        passedSourceID As Long) As Long
'
'- - - - - - - - - - - - - - - - - - - - - - - - - - G E N E R A T E D  E R R O R  C O D E ----------------
'                          
                               If IsDeveloper Then
                               Else
                                 On Error GoTo getPropertyIDFromBRT_ExistingOrAddNewOne_Error
                               End If
'- - - - - - - - - - - - - - - - - - - - - - - - - - G E N E R A T E D  E R R O R  C O D E ----------------

getPropertyIDFromBRT_ExistingOrAddNewOne = 0
'
Dim wkPropID As Long
Dim wkAddrID As Long

Dim propertySelectString As String
'
Dim rsPropAddr As ADODB.Recordset
Set rsPropAddr = New ADODB.Recordset
rsPropAddr.Open "tblProperty_Addresses", CurrentProject.Connection, adOpenKeyset, adLockOptimistic
'
Dim rsPropNew As ADODB.Recordset
Set rsPropNew = New ADODB.Recordset
rsPropNew.Open "tblProperty", CurrentProject.Connection, adOpenKeyset, adLockOptimistic
'
propertySelectString = "Select ID From tblProperty where [BRT] = " & passedBRT
'
Dim rsProp As ADODB.Recordset
Set rsProp = New ADODB.Recordset
rsProp.Open propertySelectString, CurrentProject.Connection, adOpenKeyset, adLockOptimistic
'
If rsProp.EOF Then
'
' add a new property record
'
    rsPropNew.AddNew
        '
        rsPropNew!BRT = passedBRT
        rsPropNew!BRT_AKA = 0
        rsPropNew!BRT_Former = 0
        rsPropNew!BRT_Related = 0
        rsPropNew!PropertyStatusID = ePropertyStatus.eDunning
        rsPropNew!PropAddr1 = "Unknown, created From Synch File"""
        rsPropNew!PropAddr2 = ""
        rsPropNew!PropCity = ""
        rsPropNew!PropZip = ""
        rsPropNew!PropDescription = "Unknown, created From Synch File"
        rsPropNew!DeedDate = ""
        rsPropNew!Book = ""
        rsPropNew!Page = ""
        rsPropNew!LandArea = 0
        '
        rsPropNew!FrontFeet = 0
        rsPropNew!DepthFeet = 0
        rsPropNew!UseCode = ""
        rsPropNew!AssessedValue = 0
        '
        rsPropNew!AppraisedValue = 0
        rsPropNew!LUC = 0
        rsPropNew!Comments = ""
        rsPropNew!DateAdded = passedAddTime
        '
        rsPropNew!UserAdded = passedUser
        '
    rsPropNew.Update
    '
    wkPropID = rsPropNew!ID
    getPropertyIDFromBRT_ExistingOrAddNewOne = wkPropID
    '
    writeEventLog eSystemEvent.eRecBuilt, _
                  passedBRT, _
                  wkPropID, _
                  0, _
                  0, _
                  0, _
                  0, _
                  0, _
                  0, _
                  0, _
                  0, _
                  0, _
                  "Property Rec Added In COP Synch or Direct Pay Process"
    '
    writePropertyComment wkPropID, _
                        "Property Added In COP Synch or Direct Pay Process", _
                        passedUser, _
                        1, _
                        passedBRT

    rsPropAddr.AddNew
        '
        rsPropAddr!PropertyID = wkPropID
        rsPropAddr!SourceID = passedSourceID
        rsPropAddr!BRT = passedBRT
        rsPropAddr!Name1 = "Unknown, created From Synch File"
        rsPropAddr!Name2 = "Unknown, created From Synch File"
        rsPropAddr!Name3 = "Unknown, created From Synch File"
        rsPropAddr!Address1 = ""
        rsPropAddr!Address2 = ""
        rsPropAddr!City = ""
        rsPropAddr!State = ""
        rsPropAddr!ZipCode = ""
        rsPropAddr!ZipPlusFour = ""
        rsPropAddr!DayPhone = ""
        rsPropAddr!NightPhone = ""
        '
        rsPropAddr!MobilePhone = ""
        rsPropAddr!Email = ""
        rsPropAddr!VadarMailingInterest = 0
        rsPropAddr!Active_YN = cYesNum
        '
        rsPropAddr!InterestTypeID = 4  'Other
        rsPropAddr!DefaultAddress_YN = cYesNum
        rsPropAddr!Comments = ""
        rsPropAddr!DateAdded = passedAddTime
        '
        rsPropAddr!UserAdded = passedUser
        '
    rsPropAddr.Update
    '
    wkAddrID = rsPropAddr!ID
    '
Else
    '
    ' property record exists
    '
    rsProp.MoveLast
    rsProp.MoveFirst
    '
    getPropertyIDFromBRT_ExistingOrAddNewOne = Nz(rsProp!ID, 0)
    '
End If
'
rsProp.Close
Set rsProp = Nothing
'
rsPropNew.Close
Set rsPropNew = Nothing
'
rsPropAddr.Close
Set rsPropAddr = Nothing
'

'- - - - - - - - - - - - - - - - - - - - - - - - - - G E N E R A T E D  E R R O R  C O D E ----------------
                               On Error GoTo 0
                               Exit Function
getPropertyIDFromBRT_ExistingOrAddNewOne_Error:
                               sysErrorHandler Err.Number, Err.Description, "getPropertyIDFromBRT_ExistingOrAddNewOne", "modEvent_Import_Export_Comments", "Module"
'- - - - - - - - - - - - - - - - - - - - - - - - - - G E N E R A T E D  E R R O R  C O D E ----------------


End Function

Open in new window

0
Comment
Question by:mlcktmguy
1 Comment
 
LVL 12

Accepted Solution

by:
pdebaets earned 500 total points
Comment Utility
Well, if you know who the user who caused the problem is, then you could try going to that user's computer and then opening and closing the application.

If that doesn't work, have all users close the application, MAKE A BACKUP OF YOUR FRONT AND BACK-END, then find the .ldb  or .lccdb file that gets created when Access opens a database and delete it. If you cannot delete it, then it is likely that someone still has the db open. Find that user and close the application, or have all the users shut down their computers including you. Then boot up your computer so it is the only one running (besides the server) and again attempt to delete the .ldb / .lccdb file. You should be able to delete it now.

Compact and repair the front and back-end now since you already have a backup and your users are all signed off. Now open the application and check it out. If the problem persists, please post back here.
0

Featured Post

How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

Join & Write a Comment

It took me quite some time to sort out all the different properties of combo and list boxes available from Visual Basic at run-time. Not that the documentation is lacking: the help pages are quite thorough and well written. The problem was rather wh…
A simple tool to export all objects of two Access files as text and compare it with Meld, a free diff tool.
Familiarize people with the process of retrieving data from SQL Server using an Access pass-thru query. Microsoft Access is a very powerful client/server development tool. One of the ways that you can retrieve data from a SQL Server is by using a pa…
In Microsoft Access, learn how to use Dlookup and other domain aggregate functions and one method of specifying a string value within a string. Specify the first argument, which is the expression to be returned: Specify the second argument, which …

762 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

10 Experts available now in Live!

Get 1:1 Help Now