Solved

Error 3709 The connection cannot be used in this

Posted on 2014-01-15
2
378 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
ID: 39785054
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
ID: 39785209
You are correct, that was the issue all along.  Thanks.
0

Featured Post

Free Tool: SSL Checker

Scans your site and returns information about your SSL implementation and certificate. Helpful for debugging and validating your SSL configuration.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

You need to know the location of the Office templates folder, so that when you create new templates, they are saved to that location, and thus are available for selection when creating new documents.  The steps to find the Templates folder path are …
Access developers frequently have requirements to interact with Excel (import from or output to) in their applications.  You might be able to accomplish this with the TransferSpreadsheet and OutputTo methods, but in this series of articles I will di…
Using Microsoft Access, learn some simple rules for how to construct tables in a relational database. Split up all multi-value fields into single values: Split up fields that belong to other things into separate tables: Make sure that all record…
With Secure Portal Encryption, the recipient is sent a link to their email address directing them to the email laundry delivery page. From there, the recipient will be required to enter a user name and password to enter the page. Once the recipient …

756 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