run time 3146 (odbc call failed) on second pass

T

Tom Brophy

I'm having some problems and need help. The line below executes 1 time for
each detail line (creating distribution lines) - there are currently always 3
detail lines.

If PostDistribution(lngPostedTransaction, lngPostedDetail, TmpDetailID) Then

The first detail line goes through the following function correctly. The
second time, I get the run-tim 3146 ODBC call failed when it tries to open
RSDistr.

Anybody have any ideas?

Thanks,

Tom


Function PostDistribution(lngTran As Long, lngDetail As Long, lngTmpDetailID
As Long) As Boolean
Dim db As DAO.Database
Dim RSDistr As DAO.Recordset
Dim RSTmp As DAO.Recordset
Dim strSQLDistrTmp As String
Dim strSQLDistr As String
Dim blnTransOpen As Boolean
Dim strSQL As String

On Error GoTo Err_PostDistribution
On Error GoTo 0

'DBEngine.BeginTrans

blnTransOpen = True


strSQLDistr = "SELECT * FROM tblBTransDistr"
Set db = CurrentDb
Set RSDistr = db.OpenRecordset(strSQLDistr, dbOpenDynaset, dbSeeChanges)

'*** cycle through distribution ***
strSQLDistrTmp = "SELECT * FROM tblBTransDistr_tmp" '** WHERE
fknTransactionDetail_tmpID = " & lngTmpDetailID ' & ";"
Set RSTmp = db.OpenRecordset(strSQLDistrTmp, dbOpenDynaset, dbSeeChanges)

With RSDistr
Do Until RSTmp.EOF
If RSTmp.Fields("fknTransactionDetail_tmpID") = lngTmpDetailID
Then
.AddNew
.Fields("fknTransDetailID") = lngDetail
.Fields("fknTransactionID") = lngTran
.Fields("dtPost") = Date
.Fields("ChargeAmount") = RSTmp.Fields("ChargeAmount")
.Fields("ChargeInvAmount") =
RSTmp.Fields("ChargeInvAmount")
.Fields("TIGClaim") = RSTmp.Fields("TIGClaim")
.Fields("RMBillID") = RSTmp.Fields("RMBillID")
.Fields("dtDOL") = RSTmp.Fields("dtDOL")
.Fields("TranCode") = RSTmp.Fields("TranCode")
.Fields("PmtCode") = RSTmp.Fields("PmtCode")
.Fields("ExpenseCode") = RSTmp.Fields("ExpenseCode")
.Fields("BalanceAmount") = RSTmp.Fields("ChargeAmount")
.Fields("AppliedAmount") = 0
.Fields("TotPmt") = 0
.Update
End If
RSTmp.MoveNext
Loop
End With
RSTmp.Close
RSDistr.Close
Set RSTmp = Nothing
Set RSDistr = Nothing

'DBEngine.CommitTrans
blnTransOpen = False
PostDistribution = True

Exit Function

Err_PostDistribution:
If blnTransOpen Then
' DBEngine.Rollback
'cn.RollbackTrans
MsgBox Err.Number & ": " & Err.Description, vbCritical, "Rollback
Notification"
Else
MsgBox Err.Number & ": " & Err.Description, , Me.Name & " - " &
"PostDistribution"
End If
PostDistribution = False

End Function
 
G

Guest

hi,
it ran into something it don't like. probably syntax.
what is that if statement doing?
-----Original Message-----
I'm having some problems and need help. The line below executes 1 time for
each detail line (creating distribution lines) - there are currently always 3
detail lines.

If PostDistribution(lngPostedTransaction,
Click to expand...
lngPostedDetail, TmpDetailID) Then
 
T

Tom Brophy

The 'IF' statement in the routine is checking only for those distribution
items that pertain to that detail item (notice I had tried to do the "WHERE"
clause above and still got the same problem). When I debug and hover over
that field it shows the correct variables. if it was syntax why would it go
through the entire function correctly for the first detail item and then when
it starts to begin on the second detail item it errors out?

Thanks for any help you can give me.
 
T

Tom Brophy

And if you're talking about the "if" statement that calls the routine, that
is intended to check for errors but doesn't do anything else.

If PostDistribution(lngPostedTransaction, lngPostedDetail,
TmpDetailID) Then
Else
End If
 
T

Tom Brophy

Here's the routine with the problem:

Private Function PostDistribution(lngTran As Long, lngDetail As Long,
lngTmpDetailID As Long) As Boolean
Dim db As DAO.Database
Dim RSDistr As DAO.Recordset
Dim RSTmp As DAO.Recordset
Dim strSQLDistrTmp As String
Dim strSQLDistr As String
Dim blnTransOpen As Boolean
Dim strSQL As String

On Error GoTo Err_PostDistribution
On Error GoTo 0

'DBEngine.BeginTrans

blnTransOpen = True


strSQLDistr = "SELECT * FROM tblBTransDistr"
Set db = CurrentDb
Set RSDistr = db.OpenRecordset(strSQLDistr, dbOpenDynaset, dbSeeChanges)

'*** cycle through distribution ***
strSQLDistrTmp = "SELECT * FROM tblBTransDistr_tmp WHERE
fknTransactionDetail_tmpID = " & lngTmpDetailID
Set RSTmp = db.OpenRecordset(strSQLDistrTmp, dbOpenDynaset, dbSeeChanges)

With RSDistr
Do Until RSTmp.EOF
'If RSTmp.Fields("fknTransactionDetail_tmpID") = lngTmpDetailID
Then
.AddNew
.Fields("fknTransDetailID") = lngDetail
.Fields("fknTransactionID") = lngTran
.Fields("dtPost") = Date
.Fields("ChargeAmount") = RSTmp.Fields("ChargeAmount")
.Fields("ChargeInvAmount") =
RSTmp.Fields("ChargeInvAmount")
.Fields("TIGClaim") = RSTmp.Fields("TIGClaim")
.Fields("RMBillID") = RSTmp.Fields("RMBillID")
.Fields("dtDOL") = RSTmp.Fields("dtDOL")
.Fields("TranCode") = RSTmp.Fields("TranCode")
.Fields("PmtCode") = RSTmp.Fields("PmtCode")
.Fields("ExpenseCode") = RSTmp.Fields("ExpenseCode")
.Fields("BalanceAmount") = RSTmp.Fields("ChargeAmount")
.Fields("AppliedAmount") = 0
.Fields("TotPmt") = 0
.Update
'End If
RSTmp.MoveNext
Loop
End With
RSTmp.Close
RSDistr.Close
Set RSTmp = Nothing
Set RSDistr = Nothing
Set db = Nothing

'DBEngine.CommitTrans
blnTransOpen = False
PostDistribution = True

Exit Function

Err_PostDistribution:
If blnTransOpen Then
' DBEngine.Rollback
'cn.RollbackTrans
MsgBox Err.Number & ": " & Err.Description, vbCritical, "Rollback
Notification"
Else
MsgBox Err.Number & ": " & Err.Description, , Me.Name & " - " &
"PostDistribution"
End If
PostDistribution = False

End Function



Here's the routine that calls the function above: (this was working just
fine - I just added the line that calls the function above and the lines to
get the new variables to pass to the function: TmpDetailID and
lngPostedDetail)

Function PostCharge() As Boolean
Dim cn As ADODB.Connection
Dim RS As ADODB.Recordset
Dim rsTarget As ADODB.Recordset

'Dim db As dao.Database
'Dim rs As dao.Recordset
'Dim rsTarget As dao.Recordset
Dim strSQL As String
Dim blnTransOpen As Boolean

Dim TmpDetailID As Long
Dim lngPostedDetail As Long

On Error GoTo Err_PostCharge
On Error GoTo 0

Set cn = CurrentProject.Connection

blnTransOpen = True
'DBEngine.BeginTrans
cn.BeginTrans

'lngPostedTransaction = Null
strSQL = "SELECT * FROM tblBTransactions;"
'Set db = CurrentDb
'Set rs = db.OpenRecordset(strSQL, dbOpenDynaset)
Set RS = New ADODB.Recordset
Set rsTarget = New ADODB.Recordset
RS.Open strSQL, cn, adOpenStatic, adLockPessimistic

With RS
.AddNew
.Fields("Source") = Forms!frmmainmenu!txtCurService
.Fields("ServiceType") = Forms!frmmainmenu!txtCurService
.Fields("SourceApp") = Me.SourceApp
.Fields("UserName") = CurrentUser
.Fields("ComputerName") = CurrentComputer
.Fields("dtImport") = Me.dtImport
.Fields("FileKey") = Me.FileKey
.Fields("dtSourceInvoice") = Me.dtSourceInvoice
.Fields("SourceInvoiceNum") = Me.SourceInvoiceNum
.Fields("fknClaimantsID") = Me.fknClaimantsID
.Fields("FileNum") = Me.FileNum
' .Fields("Source") = Me.Source
.Fields("dtReceived") = Me.dtReceived
.Fields("dtCompleted") = Me.dtCompleted
.Fields("dtCreated") = Now
.Fields("dtInjury") = Me.dtInjury
.Fields("dtToMD") = Me.dtToMD
.Fields("dtFromMD") = Me.dtFromMD
.Fields("ClaimNum") = Me.ClaimNum
.Fields("ReviewType") = Me.ReviewType
.Fields("ServiceRequested") = Me.ServiceRequested
.Fields("Determination") = Me.Determination
.Fields("fknAcctTypeID") = Me.fknAcctTypeID
.Fields("fknLocationID") = Me.fknLocationID
' .Fields("fknCompanyID") = Forms!frmmainmenu!CurCompany
.Fields("fknReferringSourceID") = Me.fknReferringSourceID
.Fields("RSContact") = Me.RSContact
.Fields("ynSpecRev1") = Me.ynSpecRev1
.Fields("ynSpecRev2") = Me.ynSpecRev2
.Fields("fknSalesRepID") = Me.fknSalesRepID
.Fields("fknPhysicianID") = Me.fknPhysicianID
.Fields("ynPeerPeer") = Me.ynPeerPeer
.Fields("AmtPeerPeer") = Me.txtPeerToPeerRate
.Fields("PhysRate") = Me.PhysRate
.Fields("fknInsCoID") = Me.fknInsCoID
.Fields("fknAdjusterID") = Me.fknAdjusterID
.Fields("fknEmployerID") = Me.fknEmployerID
.Fields("EmprTaxExempt") = Me.EmprTaxExempt
.Fields("fknPAEmployerID") = Me.fknPAEmployerID
.Fields("fknAttorneyID") = Me.fknAttorneyID
.Fields("Memo") = Me.Memo
.Fields("ClmtFName") = Trim$(Nz(Me.ClmtFName, ""))
.Fields("ClmtMName") = Trim$(Nz(Me.ClmtMName, ""))
.Fields("ClmtLName") = Trim$(Nz(Me.ClmtLName, ""))
.Fields("ClmtAddress") = Trim$(Nz(Me.ClmtAddress, ""))
.Fields("ClmtCity") = Trim$(Nz(Me.ClmtCity, ""))
.Fields("ClmtState") = Trim$(Nz(Me.ClmtState, ""))
.Fields("ClmtZip") = Trim$(Nz(Me.ClmtZip, ""))
.Fields("ClmtSocial") = Me.ClmtSocial
.Fields("dtBirth") = Me.dtBirth
.Fields("ClmtSex") = Me.ClmtSex
.Fields("ClmtPhone") = Me.ClmtPhone
.Fields("ClmtOccupation") = Trim$(Nz(Me.ClmtOccupation, ""))
.Fields("BillingStatus") = 2 'Charge
.Fields("BillingAmount") = Me.frmCharges.Form!ChargeAmountTTL
.Fields("BillingBalance") = Me.frmCharges.Form!ChargeAmountTTL
.Update
'.MoveLast
lngPostedTransaction = .Fields("pknTransactionsID")
.Close
End With

'**Write charges list to tblBTransDetail
strSQL = "SELECT * FROM tblBTransDetail_tmp;" ' WHERE ComputerName='" &
CurrentComputer & "';"
' Set rs = db.OpenRecordset(strSQL, dbOpenForwardOnly)
RS.Open strSQL, cn, adOpenForwardOnly, adLockReadOnly

strSQL = "SELECT * FROM tblBTransDetail;"
' Set rsTarget = db.OpenRecordset(strSQL, dbOpenDynaset)
rsTarget.Open strSQL, cn, adOpenStatic, adLockPessimistic

With rsTarget
Do Until RS.EOF
If RS.Fields("ChargeCode") > 0 Then
.AddNew
.Fields("fknTransactionsID") = lngPostedTransaction
.Fields("dtPost") = Date 'Use today's date until invoiced
.Fields("ChargeCode") = RS.Fields("ChargeCode")
.Fields("ChargeType") = RS.Fields("ChargeType")
.Fields("PayDR") = RS.Fields("PayDR")
.Fields("ChargeSysDesc") = RS.Fields("ChargeSysDesc")
.Fields("ChargeInvDesc") = RS.Fields("ChargeInvDesc")
.Fields("ChargeAmount") = RS.Fields("ChargeAmount")
.Fields("ChargeInvAmount") = RS.Fields("ChargeInvAmount")
TmpDetailID = RS.Fields("pknTransDetail_tmpID")
.Update
lngPostedDetail = .Fields("pknTransDetailID")
If PostDistribution(lngPostedTransaction, lngPostedDetail,
TmpDetailID) Then
Else
End If
End If
RS.MoveNext
Loop
End With

'Delete Item from tblImport
If Nz(Me.fknImportID, 0) <> 0 Then
' DoCmd.SetWarnings False
strSQL = "DELETE * FROM tblBImport WHERE pknImportID=" &
Me.fknImportID & ";"
cn.Execute strSQL
DoEvents
' DoCmd.RunSQL strSQL, False
' DoCmd.SetWarnings True
' Me.lstImports.Requery
End If

'delete from distribution
strSQL = "DELETE * FROM tblBTransDetail_tmp;"
cn.Execute strSQL
'delete from distribution
strSQL = "DELETE * FROM tblBTransDistr_tmp;"
cn.Execute strSQL

Set RS = Nothing
'Set db = Nothing

'DBEngine.CommitTrans
cn.CommitTrans
blnTransOpen = False
Me.lstImports.Requery
PostCharge = True

Exit Function

Err_PostCharge:
If blnTransOpen Then
' DBEngine.Rollback
cn.RollbackTrans
MsgBox Err.Number & ": " & Err.Description, vbCritical, "Rollback
Notification"
Else
MsgBox Err.Number & ": " & Err.Description, , Me.Name & " - " &
"PostCharge"
End If
PostCharge = False
End Function
 
C

Chris2

Tom Brophy said:
I'm having some problems and need help. The line below executes 1 time for
each detail line (creating distribution lines) - there are currently always 3
detail lines.

If PostDistribution(lngPostedTransaction, lngPostedDetail, TmpDetailID) Then

The first detail line goes through the following function correctly. The
second time, I get the run-tim 3146 ODBC call failed when it tries to open
RSDistr.
Click to expand...

I'm sorry, but I don't understand. RSDistr is only opened *once* in
this code. RSTemp is only opened once. How can the OpenRecordset of
RSDistr fail "on the second pass", where there is only one pass over
that part of the code?

Are you saying it fails the second time the *function* is executed?

Anybody have any ideas?

Thanks,

Tom
Click to expand...

blnTransOpen = True


strSQLDistr = "SELECT * FROM tblBTransDistr"
Set db = CurrentDb
Set RSDistr = db.OpenRecordset(strSQLDistr, dbOpenDynaset, dbSeeChanges)

'*** cycle through distribution ***
strSQLDistrTmp = "SELECT * FROM tblBTransDistr_tmp" '** WHERE
fknTransactionDetail_tmpID = " & lngTmpDetailID ' & ";"
Set RSTmp = db.OpenRecordset(strSQLDistrTmp, dbOpenDynaset, dbSeeChanges)

With RSDistr
Do Until RSTmp.EOF
If RSTmp.Fields("fknTransactionDetail_tmpID") = lngTmpDetailID
Then
.AddNew
.Fields("fknTransDetailID") = lngDetail
.Fields("fknTransactionID") = lngTran
.Fields("dtPost") = Date
.Fields("ChargeAmount") = RSTmp.Fields("ChargeAmount")
.Fields("ChargeInvAmount") =
RSTmp.Fields("ChargeInvAmount")
.Fields("TIGClaim") = RSTmp.Fields("TIGClaim")
.Fields("RMBillID") = RSTmp.Fields("RMBillID")
.Fields("dtDOL") = RSTmp.Fields("dtDOL")
.Fields("TranCode") = RSTmp.Fields("TranCode")
.Fields("PmtCode") = RSTmp.Fields("PmtCode")
.Fields("ExpenseCode") = RSTmp.Fields("ExpenseCode")
.Fields("BalanceAmount") = RSTmp.Fields("ChargeAmount")
.Fields("AppliedAmount") = 0
.Fields("TotPmt") = 0
.Update
End If
RSTmp.MoveNext
Loop
End With
RSTmp.Close
RSDistr.Close
Set RSTmp = Nothing
Set RSDistr = Nothing

'DBEngine.CommitTrans
blnTransOpen = False
PostDistribution = True

Exit Function

Err_PostDistribution:
If blnTransOpen Then
' DBEngine.Rollback
'cn.RollbackTrans
MsgBox Err.Number & ": " & Err.Description, vbCritical, "Rollback
Notification"
Else
MsgBox Err.Number & ": " & Err.Description, , Me.Name & " - " &
"PostDistribution"
End If
PostDistribution = False

End Function
Click to expand...



I notice that the db object is neither closed nor set to nothing.
That's not good.


Sincerely,

Chris O.
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Run-time error 3146 ODBC--call failed 4
Run-Time Error 3146 ODBC Call Failed 3

Top