Hey Y’all,
I have a large FE/BE database that’s been working for years however I now get an error with this code:
Code:
' +-------------------+ +----------+
'---------------------------| SetDateForBills() |-----------------| 02/17/12 |
' +-------------------+ +----------+
'Called by: AllBillsReport()
' PrintedBillsReport()
' EmailBills()
'Calls : N/A
'Returns : True if rates exist or are added.
' False if rates do not exist and are not added or Cancel button
' is selected.
Function SetDateForBills() As Boolean
Dim iAns As Integer
Dim qryName As QueryDef
Dim dbName As Database
Dim rst As Recordset
Dim zBillDate As String
Dim zSQL As String
Set dbName = CurrentDb
zBillDate = InputBox("Enter Billing Year as 4 digits", "Billing Year", Trim(Str(Year(Now()))))
zBillDate = "4/1/" & Trim(zBillDate)
dtBillDt = CDate(zBillDate)
'***** Check to see if Rates for that year are present in tblFees *****
Set rst = dbName.OpenRecordset("tblFees")
[COLOR="#FF0000"][SIZE=5]rst.Index = "PrimaryKey"[/SIZE][/COLOR]
rst.Seek "=", dtBillDt
If rst.NoMatch Then
rst.Close '**** Close the Recordset no longer needed ****
iAns = MsgBox("There are no Fees in the tblFees table for " & zBillDate & vbCrLf & _
"Would you like to enter them now?", _
vbYesNo + vbInformation, "Warning: No Fees!")
If iAns = vbYes Then
bFormMode = True '** Data Entry Mode ***
DoCmd.OpenForm "frmFees", acNormal, , , , acDialog
Else
MsgBox "There are no rates for Bill Year " & zBillDate & vbCrLf & _
"No bills will be produced at this time." & vbCrLf & _
"You will be returned to the Billing Options Menu.", _
vbOKOnly + vbInformation, "Can NOT Produce Bills:"
SetDateForBills = False
GoTo Exit_Function
End If '** if iAns **
Else
'**Code for existing rates! **
rst.Close '**** Close the Recordset no longer needed ****
iAns = MsgBox("Would you like to Edit the Fees for " & zBillDate & "?", _
vbYesNo + vbInformation, "Information: View/Edit Fees?")
If iAns = vbYes Then
bFormMode = False '** Data Edit Mode ***
DoCmd.OpenForm "frmFees", acNormal, , , , acDialog
End If '** if iAns **
End If '** rst.NoMatch **
Set qryName = dbName.QueryDefs("qryDocksForBills")
zSQL = "SELECT Owners.OwnerID, Docks.OwnerID, Docks.Dock, IIf(([MaintThru]0),[DockMaintFee],0) AS DockFee, " & _
" IIf([LiftThru]<[BillingDate],[LiftMaintFee],0) AS LiftFee," & _
" Docks.MaintThru, Docks.LiftThru, tblFees.BillingDate" & _
" FROM tblFees, Owners INNER JOIN Docks ON Owners.OwnerID = Docks.OwnerID" & _
" WHERE (((tblFees.BillingDate) = #" & zBillDate & "#))" & _
" ORDER BY Docks.OwnerID, Docks.Dock;"
qryName.sql = zSQL 'Assign SQL statement to Query Name
qryName.Close 'Close and Save the Query
Set qryName = dbName.QueryDefs("qryLotsForBills")
zSQL = "SELECT Lots.OwnerID, Lots.Lot, Lots.PropertyAddr, Lots.DuesThru, " & _
"IIf([DuesThru]<[BillingDate],[AsociationFee],0) AS AnnFee, " & _
"IIf([DuesThru]<[BillingDate],[CapitalImpFee],0) AS CImpFee, " & _
"IIf([DuesThru]<[BillingDate],[CapitalRepFee],0) AS CRepFee, " & _
"Lots.Mowing, Lots.MowingThru, IIf([Mowing]='Yes', " & _
"IIf([MowingThru]<[BillingDate] or IsNull([MowingThru])," & _
"[MowingFee],0),0) AS MowFee FROM Lots, tblFees " & _
"WHERE ((tblFees.BillingDate) = #" & zBillDate & _
"#) ORDER BY Lots.OwnerID, Lots.Lot;"
qryName.sql = zSQL 'Assign SQL statement to Query Name
qryName.Close 'Close and Save the Query
SetDateForBills = True '*** Successfully Set ***
Exit_Function:
End Function '*** SetDateForBills()***
The line highlighted in RED produces this error:
43239-Error-3251-Message-Access
I've tried modifying the Dims by prefixing DAO. to the Database and RecordSet and adding , dbOpenTable to the Set rst = argument which produces this error:
Here's the Table structure (with the exception of the last item which was what I was trying to add when I noticed the new error but I restored backups to make sure that wasn't causing the problem but didn't take a new screen capture.
43236-tblFeesStructure
I've done quite a bit of googling with out any results that work.
Sign me stumped! 😆 :cheers:
