Solved

Error 3709 The connection cannot be used in this

Posted on 2014-01-15
2
364 Views
Last Modified: 2014-01-16
I've been testing a subroutine for a while and now all of the sudden I'm getting the error

3709 The ocnnection cannot be used to perform this operation.  it is either closed or invalid.

When it encounters this statement

rsIn1.Open "aqryLarryImport_1231s_BuildTaxRecords, CurrentProject.Connection, adOpenKeyset, adLockOptimistic"

Open in new window


The query refernced in the code opens and shows all of the records when it is opened manually.  It is not oppen when this routine is running.  The output table is not open when this routine runs and also opens manually.  This is on a single user standalone machien so it is not a file locking issue.  Just for the heck of it I did decomplile the MDB and also did a compact repair on it.

Any ideas?

I have tested the logicin this secion of the subroutine multiple times and I'm working on thelogic below now.  This open statement worked many times and built the records in this loop.  Now I'm getting the above error.

I don't remember ever encountering this error so I'm not sure what to do.

Don't kknow if this will be helpful but here is the code of the entire routine:

Public Sub buildLarryPayTmpTables()
'
Dim wkFirstRec As Boolean
wkStartTime = Now()
wkCurrTime = Now()
wkProcessingDate = Now()
'
'
Dim wkName As String
wkName = "InitialPay"
'
DoCmd.SetWarnings False
selectString = "Delete * from tblPayments_Hdr_TMP_Local "
DoCmd.RunSQL selectString
'
selectString = "Delete * from tblPayments_Year_Sub_Tmp_Local "
DoCmd.RunSQL selectString
'
selectString = "Delete * from tblPayments_Fees_Sub_Tmp_Local "
DoCmd.RunSQL selectString
'
' clear link records from the process to work, it must be the only process creating anything in the workID field
'
DoCmd.SetWarnings False
updateSQL = " Update tblPayments_Hdr_TMP_Local Set [workID] = 0"
DoCmd.RunSQL updateSQL
updateSQL = " Update tblPayments_Hdr           Set [workID] = 0"
DoCmd.SetWarnings True

' Step 1 Build Hdr for each BRT by combining all years and fee totals
'
'
Dim wkPaymentSourceID As Long
Dim wkTransactionTypeID As Long
Dim wkPayDate As Date
'
Dim wkPayHdrID As Long
Dim wkPayRecID As Long

'
wkFirstRec = True
'
dispCnt = 5000
dispMax = 5
'
recsRead = 0
'
Dim rsOut As ADODB.Recordset
Set rsOut = New ADODB.Recordset
rsOut.Open "tblPayments_Hdr_TMP_Local", CurrentProject.Connection, adOpenKeyset, adLockOptimistic
'
Dim rsIn As ADODB.Recordset
Set rsIn = New ADODB.Recordset
'rsIn.Open "qry_aDirectPayImport_Insert_BuildPayHdr", CurrentProject.Connection, adOpenKeyset, adLockOptimistic
rsIn.Open "aqryLarryImport_Hdrs_BuildPayHdr", CurrentProject.Connection, adOpenKeyset, adLockOptimistic
'////////////////rsIn.Open "aqryLarryImport_Hdrs_BuildPayHdr_Only25", CurrentProject.Connection, adOpenKeyset, adLockOptimistic
If rsIn.EOF Then
    Exit Sub
Else
    If rsIn.RecordCount > 0 Then
        '
        rsIn.MoveLast
        rsIn.MoveFirst
        totRecs = rsIn.RecordCount
        '
        While Not rsIn.EOF
            '
            recsRead = recsRead + 1
            '
            dispCnt = dispCnt + 1
            If dispCnt > dispMax Then
                wkCurrTime = Now()
                dispCnt = 0
                dispMsg = "Processing Pay Hdr, Step 1 of 4, Rec " & Format(recsRead, "Standard") & " Of " & Format(totRecs, "Standard") & RunTime(wkStartTime, wkCurrTime)
                wkStatusRtn = SysCmd(acSysCmdSetStatus, dispMsg)
                DoEvents
            End If
            '
            wkPayDate = ReformatYYYYMMDDStrToShortDate(Nz(rsIn![PostmarkDate], 0))
            '
            ' Write Pay Hdr Record
            '
            rsOut.AddNew
                rsOut!PropertyID = Nz(rsIn!PropertyID, 0)
                rsOut!BRT = Nz(rsIn!BRT, 0)
                rsOut!FromTaxRecYear = 0
                rsOut!ThruTaxRecYear = 0
                rsOut!DepositDate = wkPayDate
                rsOut!DepositNum = 0
                rsOut!PaymentSourceID = ePaySource.ePhillyPayfile
                rsOut!TransactionTypeID = eTransactionType.ePayment
                rsOut!PaymentDate = wkPayDate
                rsOut!PayTypeID = 9
                rsOut!CheckNum = ""
                rsOut!CheckNum2 = ""
                rsOut!Payer = ""
                rsOut!Comment = ""
                rsOut!PayAmt = Round(Nz(rsIn![totPrincipal], 0) + Nz(rsIn![totInterest], 0) + Nz(rsIn![totPenalty], 0) + Nz(rsIn![TotLien], 0) + Nz(rsIn![totAttyFees], 0) + Nz(rsIn![TotFees], 0), 2)
                rsOut!TaxAmount = Nz(rsIn!totPrincipal, 0)
                rsOut!PenaltyAmount = Nz(rsIn!totPenalty, 0)
                rsOut!InterestAmount = Nz(rsIn!totInterest, 0)
                rsOut!AttyFeesAmount = Nz(rsIn!totAttyFees, 0)
                rsOut!LienAmount = Nz(rsIn!TotLien, 0)
                rsOut!FeesAmount = Nz(rsIn!TotFees, 0)
                rsOut!PostAs = 0
                rsOut!PostedStatusID = ePostedStatus.eUnposted
                'rsOut!PostingDate = ""
                rsOut!PostingBatchID = 0
                rsOut!DateAdded = wkProcessingDate
                rsOut!UserAdded = wkName
                rsOut!OverPayAmt = 0
                rsOut!UnderPayAmt = 0
                'rsOut!DateTimeToPhilly = now
                rsOut!BatchNumToPhilly = 987650   'GRB
                'rsOut!DateTimeFromPhilly = 1   'active
                rsOut!BatchNumFromPhilly = 0
                rsOut!InstallPlanID = Nz(rsIn!InstallPlanID, 0)
                rsOut!WorkID = Nz(rsIn!BlockID, 0)   ' used to link detail tax records and ree records below to the correct payment HDr.
                rsOut!VadarTranIndex = 0
                
            rsOut.Update
               
            wkPayHdrID = Nz(rsOut!ID, 0)
            '
            rsIn.MoveNext
        Wend
            
    End If
End If
'
rsIn.Close
Set rsIn = Nothing
'
rsOut.Close
Set rsOut = Nothing

'
' Step 2 Build Detail Pay recs using query with TaxHdrID included
'
'
dispCnt = 5000
dispMax = 999
'
recsRead = 0
'
Dim wkYearAttyFeesInterestPortion As Double
Dim wkYearAttyFeesPenaltyPortion As Double
Dim wkYearAttyFeesLienPortion As Double
Dim wkYearAttyFeesPrincipPortion As Double
'
Dim rsOut1 As ADODB.Recordset
Set rsOut1 = New ADODB.Recordset
rsOut1.Open "tblPayments_Year_Sub_Tmp_Local", CurrentProject.Connection, adOpenKeyset, adLockOptimistic
'
Dim rsIn1 As ADODB.Recordset
Set rsIn1 = New ADODB.Recordset
'rsIn1.Open "aLarryImport_1231s_BuildTaxRecords", CurrentProject.Connection, adOpenKeyset, adLockOptimistic
rsIn1.Open "aqryLarryImport_1231s_BuildTaxRecords, CurrentProject.Connection, adOpenKeyset, adLockOptimistic"
'
If rsIn1.EOF Then
    Exit Sub
Else
    If rsIn1.RecordCount > 0 Then
        '
        rsIn1.MoveLast
        rsIn1.MoveFirst
        totRecs = rsIn1.RecordCount
        '
        While Not rsIn1.EOF
            '
            recsRead = recsRead + 1
            '
            dispCnt = dispCnt + 1
            If dispCnt > dispMax Then
                wkCurrTime = Now()
                dispCnt = 0
                dispMsg = "Processing Pay Dtl Recs, Step 2 of 4, Rec " & Format(recsRead, "Standard") & " Of " & Format(totRecs, "Standard") & RunTime(wkStartTime, wkCurrTime)
                wkStatusRtn = SysCmd(acSysCmdSetStatus, dispMsg)
                DoEvents
            End If
            '
            ' Write Tax Record
            '
            rsOut1.AddNew
            '
                rsOut1!PaymentHdrID = Nz(rsIn1!PayHdrID, 0)
                rsOut1!PropertyID = Nz(rsIn1!PropertyID, 0)
                rsOut1!BRT = Nz(rsIn1!BRT, 0)
                rsOut1!TaxRecYear = Nz(rsIn1!TaxYear, 0)
                rsOut1!PayAmt = Round(Nz(rsIn1!PrincipalNum, 0) + Nz(rsIn1!InterestNum, 0) + Nz(rsIn1!PenaltyNum, 0) + Nz(rsIn1!LIenNum, 0) + Nz(rsIn1!AttyFeesNum, 0), 2)
                rsOut1!TaxAmount = Nz(rsIn1!PrincipalNum, 0)
                rsOut1!PenaltyAmount = Nz(rsIn1!PenaltyNum, 0)
                rsOut1!InterestAmount = Nz(rsIn1!InterestNum, 0)
                rsOut1!LienAmount = Nz(rsIn1!LIenNum, 0)
                rsOut1!AttyFeesAmount = Nz(rsIn1!AttyFeesNum, 0)
                '
                ' Distribute Atty Fees Total To Prin , Int, Pen and Lien portion
                '
                If Nz(rsIn1!AttyFeesNum, 0) <> 0 Then
                    wkYearAttyFeesInterestPortion = Round(Nz(rsIn1!InterestNum, 0) * 0.18, 2)
                    wkYearAttyFeesPenaltyPortion = Round(Nz(rsIn1!PenaltyNum, 0) * 0.18, 2)
                    wkYearAttyFeesLienPortion = Round(Nz(rsIn1!LIenNum, 0) * 0.18, 2)
                    wkYearAttyFeesPrincipPortion = Round(Nz(rsIn1!AttyFeesNum, 0) - wkYearAttyFeesInterestPortion - wkYearAttyFeesPenaltyPortion - wkYearAttyFeesLienPortion, 2)
                    '
                    If wkYearAttyFeesPrincipPortion < 0 Then
                        wkYearAttyFeesPrincipPortion = 0
                    End If
                Else
                    wkYearAttyFeesInterestPortion = 0
                    wkYearAttyFeesPenaltyPortion = 0
                    wkYearAttyFeesLienPortion = 0
                    wkYearAttyFeesPrincipPortion = 0
                End If
                '
                rsOut1!PrincipalAttyFees = wkYearAttyFeesPrincipPortion
                rsOut1!PenaltyAttyFees = wkYearAttyFeesPenaltyPortion
                rsOut1!InterestAttyFees = wkYearAttyFeesInterestPortion
                rsOut1!LienAttyFees = wkYearAttyFeesLienPortion
                '
                rsOut1!VadarTransactionID = 0
                rsOut1!PostedStatusID = 0
              
            rsOut1.Update
            '
            wkPayRecID = Nz(rsOut1!ID, 0)
            
            '
            rsIn1.MoveNext
        Wend
            
    End If
End If
'
rsIn1.Close
Set rsIn1 = Nothing
'
rsOut1.Close
Set rsOut1 = Nothing
'
' Associate each fee payment with a fee record for the respective BRT
'
Dim prevBlock As Long
Dim currBlock As Long
Dim wkFeeRecTaxID As Long
Dim wkFeeFeeID As Long
'
prevBlock = 9999999
'
' Step 4 Build Eligible Expense Pay Records From Vadar Detail
'
'
'selectString = "Delete * from tblPayments_Fees_Sub_Tmp_Local "
'DoCmd.SetWarnings False
'DoCmd.RunSQL selectString

'
dispCnt = 5000
dispMax = 999
'
recsRead = 0
'
Dim rsOut2 As ADODB.Recordset
Set rsOut2 = New ADODB.Recordset
rsOut2.Open "tblPayments_Fees_Sub_Tmp_Local", CurrentProject.Connection, adOpenKeyset, adLockOptimistic
'
Dim rsIn2 As ADODB.Recordset
Set rsIn2 = New ADODB.Recordset
rsIn2.Open "aqryLarryImport_0101s_BuildFeeRecs", CurrentProject.Connection, adOpenKeyset, adLockOptimistic
'
If rsIn2.EOF Then
    Exit Sub
Else
    If rsIn2.RecordCount > 0 Then
        '
        rsIn2.MoveLast
        rsIn2.MoveFirst
        totRecs = rsIn2.RecordCount
        '
        While Not rsIn2.EOF
            '
            recsRead = recsRead + 1
            '
            dispCnt = dispCnt + 1
            If dispCnt > dispMax Then
                wkCurrTime = Now()
                dispCnt = 0
                dispMsg = "Processing Fee Expense Recs, Step 3 of 4, Rec " & Format(recsRead, "Standard") & " Of " & Format(totRecs, "Standard") & RunTime(wkStartTime, wkCurrTime)
                wkStatusRtn = SysCmd(acSysCmdSetStatus, dispMsg)
                DoEvents
            End If
            '
            ' check if the block has chnaged, if so we need to load the fee tax records for this block to macth
            ' up the fee payments with an actual fee record.
            '
            currBlock = Nz(rsIn2!BlockID, 0)
            
            If prevBlock = currBlock Then
            Else
                getRelatedBlockOfFeesForMatching Nz(rsIn2!BRT, 0)
                prevBlock = currBlock
            End If
            '
            '
            ' Write Fee Record
            '
            rsOut2.AddNew
                rsOut2!PaymentHdrID = Nz(rsIn2!PaymentHdrID, 0)
                rsOut2!BRT = Nz(rsIn2!BRT, 0)
                rsOut2!PaymentYear = Nz(rsIn2![Period], 0)
                '
                
                getDirectPayFeeRecIDandFeeID Nz(rsIn2![FeeType], ""), _
                                                        wkFeeRecTaxID, _
                                                        wkFeeFeeID                '
                rsOut2!TaxFeeRecID = wkFeeRecTaxID
                '
             '   If wkFeeRecTaxID > 0 Then
             '       Stop
             '   End If
                '
                rsOut2!FeeID = wkFeeFeeID
                rsOut2!FeePayment = Nz(rsIn2![FeeNum], 0)
                rsOut2!VadarTransactionID = 0
                rsOut2!PostedStatusID = 0
'
            rsOut2.Update
            '
            rsIn2.MoveNext
        Wend
            
    End If
End If
'
rsIn2.Close
Set rsIn2 = Nothing
'
rsOut2.Close
Set rsOut2 = Nothing
'
'////////////////////////updateAnyPartialPayTaxHdrs    ' update any tax headers that are truly partial paid instead of no pay.  Couldn't do this until payments were converetd
'
wkCurrTime = Now()
dispMsg = "Complete"
wkStatusRtn = SysCmd(acSysCmdSetStatus, dispMsg & RunTime(wkStartTime, wkCurrTime))
'
'If ShowEndingMessage = True Then
'    MsgBox dispMsg & RunTime(wkStartTime, wkCurrTime)
'End If
'

End Sub

Open in new window

0
Comment
Question by:mlcktmguy
2 Comments
 
LVL 84

Accepted Solution

by:
Scott McDaniel (Microsoft Access MVP - EE MVE ) earned 500 total points
Comment Utility
Your syntax is wrong, it should be:

rsIn1.Open "aqryLarryImport_1231s_BuildTaxRecords", CurrentProject.Connection, adOpenKeyset, adLockOptimistic

Note I moved the double quote at the end of the string to surround only the name of the query. I also see that this syntax is included in the full code sample you posted, but it's commented out. See lines 157 and 158 in the code sample
0
 
LVL 1

Author Closing Comment

by:mlcktmguy
Comment Utility
You are correct, that was the issue all along.  Thanks.
0

Featured Post

How your wiki can always stay up-to-date

Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
- Increase transparency
- Onboard new hires faster
- Access from mobile/offline

Join & Write a Comment

In the article entitled Working with Objects – Part 1 (http://www.experts-exchange.com/Microsoft/Development/MS_Access/A_4942-Working-with-Objects-Part-1.html), you learned the basics of working with objects, properties, methods, and events. In Work…
Introduction When developing Access applications, often we need to know whether an object exists.  This article presents a quick and reliable routine to determine if an object exists without that object being opened. If you wanted to inspect/ite…
Show developers how to use a criteria form to limit the data that appears on an Access report. It is a common requirement that users can specify the criteria for a report at runtime. The easiest way to accomplish this is using a criteria form that a…
Polish reports in Access so they look terrific. Take yourself to another level. Equations, Back Color, Alternate Back Color. Write easy VBA Code. Tighten space to use less pages. Launch report from a menu, considering criteria only when it is filled…

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

9 Experts available now in Live!

Get 1:1 Help Now