R
Robert Nusz @ DPS
I have an database with the following:
1) A table name of Trans is the table that receives modified query results
via append requirements. To hold monthly billing transactions.
2) A table named Units that hold records of data of storage lots and how
they are to be billed, monthly, daily, weekly, semi-annual, annual.
3) A form that allows the user to enter Beginning Billing Date, Ending
Billing Date, Due Date, and Type of Invoice run. If user selects 3 from
combo73 field, user is selecting monthly billing cycle.
4) After filling in input dates (3 of them), the user selects a value for
combo73 field, a query named qryRunInvoiceSelect is then executed, selecting
data records from Units table that are to be billed on a cycle matching that
selected by user (step 3).
5) User confirms all information on form is correct, clicks a command
button to apply records, executing code Command77_click.
Code & Logic fails with the following:
The following error has occurred: Error number 3061, Error Description: Too
Fee Parameters, Expected 1, Object variable or With Block Variable Not Set.
I want to take the input (qryRunInvoiceSelect) resultant data and modifiy it
manually to be appended to the Trans table. I'm not sure if the error is
telling me it can not find a file, or can not find a specific needed value.
I would greatly appreciate a little debugging assistance in location of
issue..
Thank You In Advance,
Robert
Code follows:
Option Compare Database
' Form frmTemplate Description
' Code Date: August 9th, 2006
' Un-Licensed and Un-Authorized Use Prohibited
' Last Updated: August 9th, 2006
Private Sub cmdfrmTemplateReturn_Click()
On Error GoTo Err_cmdfrmTemplateReturn_Click
DoCmd.Close
Exit_cmdfrmTemplateReturn_Click:
Exit Sub
Err_cmdfrmTemplateReturn_Click:
MsgBox Err.Description
Resume Exit_cmdfrmTemplateReturn_Click
End Sub
Private Sub Combo73_Click()
Dim loadtype As Integer
loadtype = Combo73.Column(0)
unbtxtRunType = Combo73.Column(1)
Dim lngCount73 As Long
lngCount73 = DCount("*", "qryRunInvoiceSelect")
MsgBox " Records to Invoice - " & lngCount73, vbOKOnly, "frmRunInvoices"
If lngCount73 <> 0 Then
MsgBox " Records To Invoice = " & lngCount73
Else
MsgBox " Records To Invoice = " & lngCount73
End If
End Sub
Private Sub Command77_Click()
On Error GoTo Err_Command77_Click
funcTableExists ("Trans")
MsgBox " intTableExists = " & intTableExists
intTableExists = 1
If intTableExists = 1 Then
MsgBox " Command77 Loading Invoices "
funcLoadInvoices
Else
MsgBox " Command77-1, No Invoices To Load "
End If
Exit_Command77_Click:
Exit Sub
Err_Command77_Click:
MsgBox Err.Description
Resume Exit_Command77_Click
End Sub
Function funcRecordsInTableInt(TableName As String, Fieldname As String,
FieldValue As Integer) As Long
Dim rstRecInTableI As DAO.Recordset
Dim strSQL As String
Dim strTableField As String
Dim strFieldValue As Integer
strFieldValue = FieldValue
MsgBox "strFieldValue = " & strFieldValue
strTableField = TableName & "." & Fieldname
MsgBox " strTableField = " & strTableField
strSQL = "SELECT Count(" & strTableField & ") AS [Count] From " &
TableName & _
"WHERE " & strTableField & " = " & strFieldValue & ";"
Set rstRecInTableI = CurrentDb.OpenRecordset(strSQL, dbOpenSnapshot)
funcRecordsInTableI = rstRecInTableI!Count
rstRecInTableI.Close
Set rstRecInTableI = Nothing
End Function
Public Function funcTableExists(strTable As String) As Boolean
On Error GoTo ErrorPoint
Dim db As DAO.Database
Dim doc As DAO.Document
intTableExists = 0
Set db = CurrentDb()
With db.Containers!Tables
For Each doc In .Documents
If doc.NAME = strTable Then
funcTableExists = True
intTableExists = 1
Exit For
End If
Next doc
End With
ExitPoint:
On Error Resume Next
Set db = Nothing
Exit Function
ErrorPoint:
MsgBox " The following error has occurred: " _
& vbNewLine & "Error Number: " & Err.Number _
& vbNewLine & "Error Description: " & Err.Description _
, vbExclamation, " Unexpected Error "
Resume ExitPoint
End Function
Function funcLoadInvoices():
On Error GoTo Error_Load_Invoices
Dim rsA As Recordset
Dim rsD As DAO.Recordset
Dim intTypeRun As Integer
intTypeRun = Me.Combo73
Set rsA = CurrentDb.OpenRecordset("qryRunInvoiceSelect")
Set rsD = CurrentDb.OpenRecordset("Trans", dbOpenDynaset, dbAppendOnly)
If Not (rsA.BOF And rsA.EOF) Then
rsA.MoveFirst
Do Until rsA.EOF
With rsD
While Not rsA.EOF
Select Case intTypeRun
Case Is = 1 ' Annual Rental Invoice Insertions Routine
MsgBox " now in Case 1 "
rsD.AddNew
UnitNumb = rsA![UnitNumb]
CuNumb = rsA![CuNumb]
'transInvoice = Yes
transDate = Me.unbtxtCurrentDate ' transDate
= Current Date
transAmnt = rsA![UnRate]
transTypeDC = "D" ' transTypeDC = Debit
transBegDate = Me.unbtxtBegDate
transEndDate = Me.unbtxtEndDate
transDueDate = Me.unbtxtDueDate
transTypeRE = "R" 'R = Rental
Invoice
transDesc = "Invoice"
transWattsUsed = 0
transWattsRate = 0
transForm = "form"
rsD.Update
Case Is = 2 ' Daily Rental Invoice Insertions Routine
MsgBox " now in Case 2"
rsD.AddNew
UnitNumb = rsA![UnitNumb]
CuNumb = rsA![CuNumb]
'transInvoice = Yes
transDate = Me.unbtxtCurrentDate ' transDate
= Current Date
transAmnt = rsA![UnRate]
transTypeDC = "D" ' transTypeDC = Debit
transBegDate = Me.unbtxtBegDate
transEndDate = Me.unbtxtEndDate
transDueDate = Me.unbtxtDueDate
transTypeRE = "R" 'R = Rental
Invoice
transDesc = "Invoice"
transWattsUsed = 0
transWattsRate = 0
transForm = "form"
rsD.Update
Case Is = 3 ' Monthly Rental Invoice Insertions Routine
MsgBox " Now in Case 3 "
rsD.AddNew
UnitNumb = rsA![UnitNumb]
CuNumb = rsA![CuNumb]
'transInvoice = Yes
transDate = Me.unbtxtCurrentDate ' transDate
= Current Date
transAmnt = rsA![UnRate]
transTypeDC = "D" ' transTypeDC = Debit
transBegDate = Me.unbtxtBegDate
transEndDate = Me.unbtxtEndDate
transDueDate = Me.unbtxtDueDate
transTypeRE = "R" 'R = Rental
Invoice
transDesc = "Invoice"
transWattsUsed = 0
transWattsRate = 0
transForm = "form"
rsD.Update
Case Is = 4 ' Quarterly Rental Invoice Insertion Routine
MsgBox " Now in Case 4 "
rsD.AddNew
UnitNumb = rsA![UnitNumb]
CuNumb = rsA![CuNumb]
'transInvoice = Yes
transDate = Me.unbtxtCurrentDate ' transDate
= Current Date
transAmnt = rsA![UnRate]
transTypeDC = "D" ' transTypeDC = Debit
transBegDate = Me.unbtxtBegDate
transEndDate = Me.unbtxtEndDate
transDueDate = Me.unbtxtDueDate
transTypeRE = "R" 'R = Rental
Invoice
transDesc = "Invoice"
transWattsUsed = 0
transWattsRate = 0
transForm = "form"
rsD.Update
Case Is = 5 ' Seasonal Rental Invoice Insertion Routine
MsgBox " Now In Case 5 "
rsD.AddNew
UnitNumb = rsA![UnitNumb]
CuNumb = rsA![CuNumb]
'transInvoice = Yes
transDate = Me.unbtxtCurrentDate ' transDate
= Current Date
transAmnt = rsA![UnRate]
transTypeDC = "D" ' transTypeDC = Debit
transBegDate = Me.unbtxtBegDate
transEndDate = Me.unbtxtEndDate
transDueDate = Me.unbtxtDueDate
transTypeRE = "R" 'R = Rental
Invoice
transDesc = "Invoice"
transWattsUsed = 0
transWattsRate = 0
transForm = "form"
rsD.Update
Case Is = 6 ' Semi-Annual Rental Invoice Insertion
Routine
MsgBox " Now in Case 6 "
rsD.AddNew
UnitNumb = rsA![UnitNumb]
CuNumb = rsA![CuNumb]
'transInvoice = Yes
transDate = Me.unbtxtCurrentDate ' transDate
= Current Date
transAmnt = rsA![UnRate]
transTypeDC = "D" ' transTypeDC = Debit
transBegDate = Me.unbtxtBegDate
transEndDate = Me.unbtxtEndDate
transDueDate = Me.unbtxtDueDate
transTypeRE = "R" 'R = Rental
Invoice
transDesc = "Invoice"
transWattsUsed = 0
transWattsRate = 0
transForm = "form"
rsD.Update
Case Is = 7 ' Weekly Rental Invoice Insertion Routine
MsgBox " Now in Case 7 "
rsD.AddNew
UnitNumb = rsA![UnitNumb]
CuNumb = rsA![CuNumb]
'transInvoice = Yes
transDate = Me.unbtxtCurrentDate ' transDate
= Current Date
transAmnt = rsA![UnRate]
transTypeDC = "D" ' transTypeDC = Debit
transBegDate = Me.unbtxtBegDate
transEndDate = Me.unbtxtEndDate
transDueDate = Me.unbtxtDueDate
transTypeRE = "R" 'R = Rental
Invoice
transDesc = "Invoice"
transWattsUsed = 0
transWattsRate = 0
transForm = "form"
rsD.Update
End Select
rsA.MoveNext
Wend ' ties to "While Not rsA.EOF"
End With ' ties to "With rsD"
Loop ' ties to "Do Until rsA.EOF"
End If
rsA.Close
rsD.Close
Set rsA = Nothing
Set rsD = Nothing
Exit_funcLoadInvoices:
' Clean Up Code
On Error Resume Next
Exit Function
Error_Load_Invoices:
Select Case Err.Number
Case 2501
' Action Cancelled By User, Ignore Error
Case Else
' Unexpected Error Encountered
MsgBox " The following Error Has Occurred " _
& vbNewLine & "Error Number: " & Err.Number _
& vbNewLine & " Error Description: " & Err.Description _
, vbExclamation, " Unexpected Error "
End Select
rsA.Close
rsD.Close
Set rsA = Nothing
Set rsD = Nothing
Resume Exit_funcLoadInvoices
End Function
1) A table name of Trans is the table that receives modified query results
via append requirements. To hold monthly billing transactions.
2) A table named Units that hold records of data of storage lots and how
they are to be billed, monthly, daily, weekly, semi-annual, annual.
3) A form that allows the user to enter Beginning Billing Date, Ending
Billing Date, Due Date, and Type of Invoice run. If user selects 3 from
combo73 field, user is selecting monthly billing cycle.
4) After filling in input dates (3 of them), the user selects a value for
combo73 field, a query named qryRunInvoiceSelect is then executed, selecting
data records from Units table that are to be billed on a cycle matching that
selected by user (step 3).
5) User confirms all information on form is correct, clicks a command
button to apply records, executing code Command77_click.
Code & Logic fails with the following:
The following error has occurred: Error number 3061, Error Description: Too
Fee Parameters, Expected 1, Object variable or With Block Variable Not Set.
I want to take the input (qryRunInvoiceSelect) resultant data and modifiy it
manually to be appended to the Trans table. I'm not sure if the error is
telling me it can not find a file, or can not find a specific needed value.
I would greatly appreciate a little debugging assistance in location of
issue..
Thank You In Advance,
Robert
Code follows:
Option Compare Database
' Form frmTemplate Description
' Code Date: August 9th, 2006
' Un-Licensed and Un-Authorized Use Prohibited
' Last Updated: August 9th, 2006
Private Sub cmdfrmTemplateReturn_Click()
On Error GoTo Err_cmdfrmTemplateReturn_Click
DoCmd.Close
Exit_cmdfrmTemplateReturn_Click:
Exit Sub
Err_cmdfrmTemplateReturn_Click:
MsgBox Err.Description
Resume Exit_cmdfrmTemplateReturn_Click
End Sub
Private Sub Combo73_Click()
Dim loadtype As Integer
loadtype = Combo73.Column(0)
unbtxtRunType = Combo73.Column(1)
Dim lngCount73 As Long
lngCount73 = DCount("*", "qryRunInvoiceSelect")
MsgBox " Records to Invoice - " & lngCount73, vbOKOnly, "frmRunInvoices"
If lngCount73 <> 0 Then
MsgBox " Records To Invoice = " & lngCount73
Else
MsgBox " Records To Invoice = " & lngCount73
End If
End Sub
Private Sub Command77_Click()
On Error GoTo Err_Command77_Click
funcTableExists ("Trans")
MsgBox " intTableExists = " & intTableExists
intTableExists = 1
If intTableExists = 1 Then
MsgBox " Command77 Loading Invoices "
funcLoadInvoices
Else
MsgBox " Command77-1, No Invoices To Load "
End If
Exit_Command77_Click:
Exit Sub
Err_Command77_Click:
MsgBox Err.Description
Resume Exit_Command77_Click
End Sub
Function funcRecordsInTableInt(TableName As String, Fieldname As String,
FieldValue As Integer) As Long
Dim rstRecInTableI As DAO.Recordset
Dim strSQL As String
Dim strTableField As String
Dim strFieldValue As Integer
strFieldValue = FieldValue
MsgBox "strFieldValue = " & strFieldValue
strTableField = TableName & "." & Fieldname
MsgBox " strTableField = " & strTableField
strSQL = "SELECT Count(" & strTableField & ") AS [Count] From " &
TableName & _
"WHERE " & strTableField & " = " & strFieldValue & ";"
Set rstRecInTableI = CurrentDb.OpenRecordset(strSQL, dbOpenSnapshot)
funcRecordsInTableI = rstRecInTableI!Count
rstRecInTableI.Close
Set rstRecInTableI = Nothing
End Function
Public Function funcTableExists(strTable As String) As Boolean
On Error GoTo ErrorPoint
Dim db As DAO.Database
Dim doc As DAO.Document
intTableExists = 0
Set db = CurrentDb()
With db.Containers!Tables
For Each doc In .Documents
If doc.NAME = strTable Then
funcTableExists = True
intTableExists = 1
Exit For
End If
Next doc
End With
ExitPoint:
On Error Resume Next
Set db = Nothing
Exit Function
ErrorPoint:
MsgBox " The following error has occurred: " _
& vbNewLine & "Error Number: " & Err.Number _
& vbNewLine & "Error Description: " & Err.Description _
, vbExclamation, " Unexpected Error "
Resume ExitPoint
End Function
Function funcLoadInvoices():
On Error GoTo Error_Load_Invoices
Dim rsA As Recordset
Dim rsD As DAO.Recordset
Dim intTypeRun As Integer
intTypeRun = Me.Combo73
Set rsA = CurrentDb.OpenRecordset("qryRunInvoiceSelect")
Set rsD = CurrentDb.OpenRecordset("Trans", dbOpenDynaset, dbAppendOnly)
If Not (rsA.BOF And rsA.EOF) Then
rsA.MoveFirst
Do Until rsA.EOF
With rsD
While Not rsA.EOF
Select Case intTypeRun
Case Is = 1 ' Annual Rental Invoice Insertions Routine
MsgBox " now in Case 1 "
rsD.AddNew
UnitNumb = rsA![UnitNumb]
CuNumb = rsA![CuNumb]
'transInvoice = Yes
transDate = Me.unbtxtCurrentDate ' transDate
= Current Date
transAmnt = rsA![UnRate]
transTypeDC = "D" ' transTypeDC = Debit
transBegDate = Me.unbtxtBegDate
transEndDate = Me.unbtxtEndDate
transDueDate = Me.unbtxtDueDate
transTypeRE = "R" 'R = Rental
Invoice
transDesc = "Invoice"
transWattsUsed = 0
transWattsRate = 0
transForm = "form"
rsD.Update
Case Is = 2 ' Daily Rental Invoice Insertions Routine
MsgBox " now in Case 2"
rsD.AddNew
UnitNumb = rsA![UnitNumb]
CuNumb = rsA![CuNumb]
'transInvoice = Yes
transDate = Me.unbtxtCurrentDate ' transDate
= Current Date
transAmnt = rsA![UnRate]
transTypeDC = "D" ' transTypeDC = Debit
transBegDate = Me.unbtxtBegDate
transEndDate = Me.unbtxtEndDate
transDueDate = Me.unbtxtDueDate
transTypeRE = "R" 'R = Rental
Invoice
transDesc = "Invoice"
transWattsUsed = 0
transWattsRate = 0
transForm = "form"
rsD.Update
Case Is = 3 ' Monthly Rental Invoice Insertions Routine
MsgBox " Now in Case 3 "
rsD.AddNew
UnitNumb = rsA![UnitNumb]
CuNumb = rsA![CuNumb]
'transInvoice = Yes
transDate = Me.unbtxtCurrentDate ' transDate
= Current Date
transAmnt = rsA![UnRate]
transTypeDC = "D" ' transTypeDC = Debit
transBegDate = Me.unbtxtBegDate
transEndDate = Me.unbtxtEndDate
transDueDate = Me.unbtxtDueDate
transTypeRE = "R" 'R = Rental
Invoice
transDesc = "Invoice"
transWattsUsed = 0
transWattsRate = 0
transForm = "form"
rsD.Update
Case Is = 4 ' Quarterly Rental Invoice Insertion Routine
MsgBox " Now in Case 4 "
rsD.AddNew
UnitNumb = rsA![UnitNumb]
CuNumb = rsA![CuNumb]
'transInvoice = Yes
transDate = Me.unbtxtCurrentDate ' transDate
= Current Date
transAmnt = rsA![UnRate]
transTypeDC = "D" ' transTypeDC = Debit
transBegDate = Me.unbtxtBegDate
transEndDate = Me.unbtxtEndDate
transDueDate = Me.unbtxtDueDate
transTypeRE = "R" 'R = Rental
Invoice
transDesc = "Invoice"
transWattsUsed = 0
transWattsRate = 0
transForm = "form"
rsD.Update
Case Is = 5 ' Seasonal Rental Invoice Insertion Routine
MsgBox " Now In Case 5 "
rsD.AddNew
UnitNumb = rsA![UnitNumb]
CuNumb = rsA![CuNumb]
'transInvoice = Yes
transDate = Me.unbtxtCurrentDate ' transDate
= Current Date
transAmnt = rsA![UnRate]
transTypeDC = "D" ' transTypeDC = Debit
transBegDate = Me.unbtxtBegDate
transEndDate = Me.unbtxtEndDate
transDueDate = Me.unbtxtDueDate
transTypeRE = "R" 'R = Rental
Invoice
transDesc = "Invoice"
transWattsUsed = 0
transWattsRate = 0
transForm = "form"
rsD.Update
Case Is = 6 ' Semi-Annual Rental Invoice Insertion
Routine
MsgBox " Now in Case 6 "
rsD.AddNew
UnitNumb = rsA![UnitNumb]
CuNumb = rsA![CuNumb]
'transInvoice = Yes
transDate = Me.unbtxtCurrentDate ' transDate
= Current Date
transAmnt = rsA![UnRate]
transTypeDC = "D" ' transTypeDC = Debit
transBegDate = Me.unbtxtBegDate
transEndDate = Me.unbtxtEndDate
transDueDate = Me.unbtxtDueDate
transTypeRE = "R" 'R = Rental
Invoice
transDesc = "Invoice"
transWattsUsed = 0
transWattsRate = 0
transForm = "form"
rsD.Update
Case Is = 7 ' Weekly Rental Invoice Insertion Routine
MsgBox " Now in Case 7 "
rsD.AddNew
UnitNumb = rsA![UnitNumb]
CuNumb = rsA![CuNumb]
'transInvoice = Yes
transDate = Me.unbtxtCurrentDate ' transDate
= Current Date
transAmnt = rsA![UnRate]
transTypeDC = "D" ' transTypeDC = Debit
transBegDate = Me.unbtxtBegDate
transEndDate = Me.unbtxtEndDate
transDueDate = Me.unbtxtDueDate
transTypeRE = "R" 'R = Rental
Invoice
transDesc = "Invoice"
transWattsUsed = 0
transWattsRate = 0
transForm = "form"
rsD.Update
End Select
rsA.MoveNext
Wend ' ties to "While Not rsA.EOF"
End With ' ties to "With rsD"
Loop ' ties to "Do Until rsA.EOF"
End If
rsA.Close
rsD.Close
Set rsA = Nothing
Set rsD = Nothing
Exit_funcLoadInvoices:
' Clean Up Code
On Error Resume Next
Exit Function
Error_Load_Invoices:
Select Case Err.Number
Case 2501
' Action Cancelled By User, Ignore Error
Case Else
' Unexpected Error Encountered
MsgBox " The following Error Has Occurred " _
& vbNewLine & "Error Number: " & Err.Number _
& vbNewLine & " Error Description: " & Err.Description _
, vbExclamation, " Unexpected Error "
End Select
rsA.Close
rsD.Close
Set rsA = Nothing
Set rsD = Nothing
Resume Exit_funcLoadInvoices
End Function