Error 3709 The connection cannot be used in this
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
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:
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"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 SubASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER