我正在创建一个VBA脚本的问题,我认为这是最好的问题。我将给出一些背景知识:
我正在编写这个程序,因为我的很多客户违反了我国税务局的定期发行文件并支付现金,然后让我计算该特定金额的税额。这是一个相当多的文书工作,手动解决,所以我正在编写一个应用程序来做到这一点,还有更多。下面的脚本是需要完成的工作的核心。
对于第一个用例,我基本上在Access中创建了一个单用形式 - 没有写入任何内容,只是用于临时计算并被发送到打印机 - 计算假期工资。
由于我无法在计算单元格中执行SQL查找,因此我正在运行一个VBA脚本来为我做繁重的工作,并将三个输入的值作为参数传递。
然而,我似乎无法摆脱3075的运行时错误,而我无法为我的生活找出它的来源。我已将其追溯到SQL语句,但我找不到会出现运算符错误的位置。我哪里错了?
以下是代码:
Option Compare Database
Public Function DetermineTax(CurrentDate As Date, CurrWageType As String, CalcNetWages As Currency)
'Checks whether required fields are blank
If Not (IsDate(CurrentDate)) Then
Exit Function
End If
If (CurrWageType = "") Then
Exit Function
End If
If (CalcNetWages <= CCur(0#)) Then
Exit Function
End If
Dim strSQL As String
'Calculates tax based on (-((n-b)/(a-1))-n) formula, where all WHERE arguments have been met.
strSQL =
"SELECT FIRST (ROUND(((-(CalcNetWages-tblWageRate.CoefficientB)/(tblWageRate.CoefficientA-1))-CalcNetWages))) " & _
"FROM tblWageType INNER JOIN tblWageRate " & _
"ON tblWageType.WageTypeID = tblWageRate.fk_WageTypeID " & _
"WHERE tblWageRate.TaxYearStart <= CurrentDate And " & _
"tblWageRate.TaxYearEnd >= CurrentDate And " & _
"tblWageType.WageType = CurrWageType And " & _
"tblWageRate.Net >= CalcNetWages;"
CurrentDb.Execute Query:=strSQL, Options:=dbFailOnError + dbSeeChanges
'DoCmd.RunSQL strSQL
End Function
当然,如果还有其他问题,我会回答它们。
谢谢!
编辑:呃,我一直在看这段代码太久了。 ROUND函数需要封装在括号中。摆脱了错误3075.我已将上面的代码修改为现在的位置。
但是现在我收到错误3065“无法执行选择查询”。通过一些初步的谷歌搜索似乎我不能在表单中使用SELECT字段,但我不认为这应该有所作为,因为我在模块中调用它。当我上床睡觉时,明天我会进一步尝试,但与此同时有人有任何想法吗?
答案 0 :(得分:0)
我最终在本周解决了我的问题。我认为问题是a)处理日期的方式和b)缺少引号。
这还包括我拥有的代码a)调用有问题的函数,b)将其附加到表中。
Option Compare Database
Option Explicit
Private Sub btnCalc_Click()
Me.txtWeeklyTax = CalcNetTax(Me.txtWeeklyNet, Me.txtDatePaid, Me.cmbTaxType)
End Sub
Private Sub btnInsertRec_Click()
Dim strSQL As String
strSQL = ""
strSQL = strSQL & "INSERT INTO tblPayment "
strSQL = strSQL & " ( "
strSQL = strSQL & " fk_EmployerID, "
strSQL = strSQL & " fk_EmployeeID, "
strSQL = strSQL & " PaymentDate , "
strSQL = strSQL & " fk_WageTypeID, "
strSQL = strSQL & " NetPayment , "
strSQL = strSQL & " TaxPayable "
strSQL = strSQL & " ) "
strSQL = strSQL & "VALUES "
strSQL = strSQL & " ( "
strSQL = strSQL & " '" & Me.cmbEmployer & "', "
strSQL = strSQL & " '" & Me.cmbEmployee & "', "
strSQL = strSQL & " '" & Me.txtDatePaid & "', "
strSQL = strSQL & " '" & Me.cmbTaxType & "', "
strSQL = strSQL & " '" & Me.txtPropNet & "', "
strSQL = strSQL & " '" & Me.txtPropTax & "' "
strSQL = strSQL & ");"
'strSQL = strSQL & "VALUES "
'strSQL = strSQL & " ( "
'strSQL = strSQL & " '" & Me.[cmbEmployer] & "', "
'strSQL = strSQL & " '" & Me.[cmbEmployee] & "', "
'strSQL = strSQL & " '" & Me.[txtDatePaid] & "', "
'strSQL = strSQL & " '" & Me.[cmbTaxType] & "', "
'strSQL = strSQL & " '" & Me.[txtPropNet] & "', "
'strSQL = strSQL & " '" & Me.[txtPropTax] & "', "
'strSQL = strSQL & ");"
Debug.Print strSQL
DoCmd.RunSQL (strSQL)
Call cmdReset_Click
End Sub
Private Sub cmbEmployer_AfterUpdate()
Me.cmbEmployee.Requery
End Sub
Private Sub cmdReset_Click()
On Error GoTo ResetError
Dim Frm As Form, Ctl As Control
Set Frm = Me
For Each Ctl In Frm
Ctl.Value = Null
Next Ctl
ResetError:
If Err = 2119 Or Err = 438 Or Err = 2448 Then
Resume Next
ElseIf Err > 0 Then
MsgBox Err & ": " & Err.Description
End If
End Sub
实际税务功能......
Option Compare Database
Option Explicit
Public Function CalcNetTax(NetPay As Currency, PayDate As Date, TaxType As Integer) As Currency
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim strSQL As String
Set db = CurrentDb
strSQL = ""
strSQL = strSQL & "SELECT FIRST (ROUND((-(" & [NetPay] & "-tblWageRate.[CoefficientB])/(tblWageRate.[CoefficientA]-1)-" & [NetPay] & "))) AS TaxPayable "
strSQL = strSQL & "FROM tblWageType "
strSQL = strSQL & " INNER JOIN tblWageRate "
strSQL = strSQL & " ON tblWageType.[WageTypeID] = tblWageRate.[fk_WageTypeID] "
strSQL = strSQL & "WHERE ( "
strSQL = strSQL & " ( "
strSQL = strSQL & " ( "
strSQL = strSQL & " tblWageRate.[TaxYearStart] "
strSQL = strSQL & " ) "
strSQL = strSQL & " <= " & SQLDate([PayDate]) & " "
strSQL = strSQL & " ) "
strSQL = strSQL & " AND "
strSQL = strSQL & " ( "
strSQL = strSQL & " ( "
strSQL = strSQL & " tblWageRate.[TaxYearEnd] "
strSQL = strSQL & " ) "
strSQL = strSQL & " >= " & SQLDate([PayDate]) & " "
strSQL = strSQL & " ) "
strSQL = strSQL & " AND "
strSQL = strSQL & " ( "
strSQL = strSQL & " ( "
strSQL = strSQL & " tblWageType.[WageTypeID] "
strSQL = strSQL & " ) "
strSQL = strSQL & " = " & [TaxType] & " "
strSQL = strSQL & " ) "
strSQL = strSQL & " AND "
strSQL = strSQL & " ( "
strSQL = strSQL & " ( "
strSQL = strSQL & " tblWageRate.[Net] "
strSQL = strSQL & " ) "
strSQL = strSQL & " >= " & [NetPay] & " "
strSQL = strSQL & " ) "
strSQL = strSQL & " );"
Debug.Print strSQL
Set rs = db.OpenRecordset(strSQL)
rs.MoveFirst
CalcNetTax = CCur(rs.Fields(0))
rs.Close
db.Close
Set rs = Nothing
Set db = Nothing
End Function
Private Function SQLDate(vDate As Variant) As String
If IsDate(vDate) Then
SQLDate = "#" & Format$(vDate, "mm\/dd\/yyyy") & "#"
End If
End Function