Can I convert my query to use select .. like .. or? - sql

Can the query in the code below be converted to Select / Like / Or ?
Private Sub cmdQDef_Click()
Dim qd As DAO.QueryDef, db As DAO.Database
Dim ssql As String, WhereName As String, WhereTitle As String
Set db = CurrentDb
If Me.FilterName & "" = "" Then
DoCmd.OpenQuery "q_Search_qdef"
Exit Sub
Else
End If
ssql = "Select * From Employees"
Set qd = db.QueryDefs("q_Search_qdef")
WhereName = "'" & Replace(Me.FilterName, ",", "','") & "'"
WhereTitle = "'" & Replace(Me.FilterTitle, ",", "','") & "'"
ssql = ssql & " Where [First name] In(" & WhereName & ")AND " & _
"[Job Title] In (" & WhereTitle & ")"
qd.SQL = ssql
DoCmd.OpenQuery "q_Search_qdef"
End Sub


Yes:
WhereName = "'*" & Replace(Me.FilterName, ",", "','") & "*'"
WhereTitle = "'" & Replace(Me.FilterTitle, ",", "','") & "'"
ssql = ssql & " Where ([First name] Like " & WhereName & ") OR " & _
"([Job Title] In (" & WhereTitle & ")"

Related

Trying to upsize from Access tables to SQL Server linked tables. Code works fine with Access but gives a "ODBC call failed 3146" when connected to SQL

Public Sub UpdateTermFeedbackAddlReqt(ByVal runid As Integer, ByVal BHTerm As String, ByVal username As String, ByVal currtime As Double)
Dim db As DAO.Database
Dim rs As DAO.Recordset
DoCmd.SetWarnings False
Set db = CurrentDb
sql = "SELECT tbl_SCG_ExpectedTraffic.BHTerm, Sum(tbl_SCG_ExpectedTraffic.CurrSent2) AS SumOfCurrSent2, iif(Sum([CurrSent2]) = 0, 0, Sum([Accepted])/Sum([CurrSent2])) AS [Term Accept Rate], Sum(tbl_SCG_ExpectedTraffic.Accepted) AS SumOfAccepted, Sum(tbl_SCG_ExpectedTraffic.Rejected) AS SumOfRejected, Sum(tbl_SCG_ExpectedTraffic.Modified) AS SumOfModified, Sum(tbl_SCG_ExpectedTraffic.CurrCalledin) AS SumOfCalledin, Sum([ExpTotal])-Sum([CurrSent2]) AS [Need to Send]" & _
" FROM tbl_SCG_ExpectedTraffic" & _
" GROUP BY Date(), tbl_SCG_ExpectedTraffic.BHTerm, tbl_SCG_ExpectedTraffic.OptRunID" & _
" HAVING (((tbl_SCG_ExpectedTraffic.OptRunID)=" & runid & ") And BHTerm= """ & BHTerm & """);"
Set rs = db.OpenRecordset(sql, dbOpenDynaset, dbSeeChanges)
DoCmd.RunSQL ("Update tbl_SCG_TerminalFeedback set [CurrentSend2] = " & rs![SumOfCurrSent2] & ", [Term Accept Rate] =" & rs![Term Accept Rate] & ", Accepted= " & rs![SumOfAccepted] & ", Rejected = " & rs![SumOfRejected] & ", Modified =" & rs![SumOfModified] & ", Calledin = " & rs![SumOfCalledin] & ", AddlReqst =" & rs![Need To Send] & _
",[Last Update User] =""" & username & """, [Last Update Time]= " & currtime & " , HrDiff = iif( isnull(DLookup(""SubmissionDT"", ""tbl_SCG_OptRunSummary"", ""OptRunID = " & runid & """)), 0, Round((" & currtime & " - DLookup(""SubmissionDT"", ""tbl_SCG_OptRunSummary"", ""OptRunID =" & runid & """)) * 24, 1))" & _
" where OptRunID = " & runid & " And Term = """ & BHTerm & """")
DoCmd.SetWarnings True
rs.Close
db.Close
End Sub

Looping Code is not moving through the form

I have a form in my database that pulls data from a query to calculate the subassembly parts needed on a weekly basis and with the click of the "complete" button the required components should be moved into and out of inventory yet nothing happens when the complete button is clicked. The code should loop through and move all the parts but nothing happens.
I have stepped through to see if there are any errors and corrected a few syntax errors but that is all I have done.
Private Sub Command96_Click()
Dim ctl As Control
Dim ctln
Dim Qty As Double
Dim db As DAO.Database
Set db = CurrentDb
Dim rs As DAO.Recordset
For Each ctl In Me.Controls
Select Case TypeName(ctl)
Case "TextBox"
Select Case ctl.ControlName
Case ctl Like "*Q"
ctln = Me.Controls(Right(ctl, Len(ctl) - 1))
If Not IsNull(DLookup("[In]", "[Inventory]", "[PartNum] = '" & ctln & "'AND [YearNum] = " & Me.YearNum & " AND [WeekNum] = " & Me.WeekNum & "")) Then
num = DLookup("[In]", "[Inventory]", "[PartNum] = '" & ctln & "' AND [YearNum] = " & Me.YearNum & " AND [WeekNum] = " & Me.WeekNum & "") + ctl
Else
num = ctl
End If
If Not IsNull(DLookup("[PartNum]", "[Inventory]", "[PartNum] = '" & ctln & "'AND [YearNum] = " & Me.YearNum & " AND [WeekNum] = " & Me.WeekNum & "")) Then
CurrentDb.Execute "UPDATE [Inventory] " _
& "SET [In] = " & num & " " _
& "WHERE [PartNum] = '" & ctln & "'AND [YearNum] = " & Me.YearNum & " AND [WeekNum] = " & Me.WeekNum & "", dbFailOnError
Else
CurrentDb.Execute "INSERT INTO [Inventory] " _
& "VALUES ('" & ctln & "'," & Me.YearNum & "," & Me.WeekNum & "," & num & ",0)", dbFailOnError
End If
num = 0
Set rs = db.OpenRecordset("SELECT UsedPartNum, (Quantity * " & ctl & ") AS Used FROM SubPartsUsed WHERE FinPartNum = '" & PartNum & "'", dbOpenDynaset)
If Not (rs.EOF And rs.BOF) Then
rs.MoveFirst
Do Until rs.EOF = True
If Not IsNull(DLookup("[Out]", "[Inventory]", "[PartNum] = '" & rs!UsedPartNum & "'AND [YearNum] = " & Me.YearNum & " AND [WeekNum] = " & Me.WeekNum & "")) Then
num = DLookup("[Out]", "[Inventory]", "[PartNum] = '" & rs!UsedPartNum & "' AND [YearNum] = " & Me.YearNum & " AND [WeekNum] = " & Me.WeekNum & "") + rs!Used
Else
num = rs!Used
End If
If Not IsNull(DLookup("[PartNum]", "[Inventory]", "[PartNum] = '" & rs!UsedPartNum & "'AND [YearNum] = " & Me.YearNum & " AND [WeekNum] = " & Me.WeekNum & "")) Then
CurrentDb.Execute "UPDATE [Inventory] " _
& "SET [Out] = " & num & " " _
& "WHERE [PartNum] = '" & rs!UsedPartNum & "'AND [YearNum] = " & Me.YearNum & " AND [WeekNum] = " & Me.WeekNum & ""
Else
CurrentDb.Execute "INSERT INTO [Inventory] " _
& "VALUES ('" & rs!UsedPartNum & "'," & Me.YearNum & "," & Me.WeekNum & ",0," & num & ")"
End If
rs.MoveNext
Loop
End If
rs.Close
Set rs = Nothing
End Select
End Select
I expect the parts to be entered into inventory as complete subassembly parts and the components to make them should be removed from inventory.

Code is done by high professional specialist in VBA, many shortcuts for code executing. It could be difficult for new VBA programmer to correct this code, so I think:
first step should be adding Debug.Print code executed here at line number XXX in order to study what lines are executed, and if their execution is done as assumpted.
After that, if there is OK with code logic, Debug.Print all SQL statements, that are generated. So you can check their correctness through executing in query designer
E.g.:
Private Sub Command96_Click()
Dim ctl As Control
Dim ctln
Dim Qty As Double
Dim db As DAO.Database
Set db = CurrentDb
Dim rs As DAO.Recordset
Dim sSQL As String
For Each ctl In Me.Controls
Select Case TypeName(ctl)
Debug.Pring "looping through controls"
Case "TextBox"
Select Case ctl.ControlName
Case ctl Like "*Q"
Debug.Pring "Control with Q letter is found"
ctln = Me.Controls(Right(ctl, Len(ctl) - 1))
If Not IsNull(DLookup("[In]", "[Inventory]", "[PartNum] = '" & ctln & "'AND [YearNum] = " & Me.YearNum & " AND [WeekNum] = " & Me.WeekNum & "")) Then
Debug.Print "Num is DLookuped"
num = DLookup("[In]", "[Inventory]", "[PartNum] = '" & ctln & "' AND [YearNum] = " & Me.YearNum & " AND [WeekNum] = " & Me.WeekNum & "") + ctl
Else
num = ctl
End If
If Not IsNull(DLookup("[PartNum]", "[Inventory]", "[PartNum] = '" & ctln & "'AND [YearNum] = " & Me.YearNum & " AND [WeekNum] = " & Me.WeekNum & "")) Then
Debug.Print "Executing Update Query for not null dlookup"
sSQL = "UPDATE [Inventory] " _
& "SET [In] = " & num & " " _
& "WHERE [PartNum] = '" & ctln & "'AND [YearNum] = " & Me.YearNum & " AND [WeekNum] = " & Me.WeekNum & ""
Debug.Print sSQL
CurrentDb.Execute sSQL, dbFailOnError
Else
Debug.Print "Executing Update Query for null dlookup"
sSQL = "INSERT INTO [Inventory] " _
& "VALUES ('" & ctln & "'," & Me.YearNum & "," & Me.WeekNum & "," & num & ",0)"
Debug.Print sSQL
CurrentDb.Execute sSQL, dbFailOnError
End If
num = 0
Set rs = db.OpenRecordset("SELECT UsedPartNum, (Quantity * " & ctl & ") AS Used FROM SubPartsUsed WHERE FinPartNum = '" & PartNum & "'", dbOpenDynaset)
If Not (rs.EOF And rs.BOF) Then
Debug.Print "Beginning action for each record in PartNum select query"
rs.MoveFirst
Do Until rs.EOF = True
If Not IsNull(DLookup("[Out]", "[Inventory]", "[PartNum] = '" & rs!UsedPartNum & "'AND [YearNum] = " & Me.YearNum & " AND [WeekNum] = " & Me.WeekNum & "")) Then
Debug.Print "Executing Dlookup for element in PartNum select query"
num = DLookup("[Out]", "[Inventory]", "[PartNum] = '" & rs!UsedPartNum & "' AND [YearNum] = " & Me.YearNum & " AND [WeekNum] = " & Me.WeekNum & "") + rs!Used
Else
num = rs!Used
End If
If Not IsNull(DLookup("[PartNum]", "[Inventory]", "[PartNum] = '" & rs!UsedPartNum & "'AND [YearNum] = " & Me.YearNum & " AND [WeekNum] = " & Me.WeekNum & "")) Then
Debug.Print "Executing Update for not null DLookup element in PartNum select query"
sSQL = "UPDATE [Inventory] " _
& "SET [Out] = " & num & " " _
& "WHERE [PartNum] = '" & rs!UsedPartNum & "'AND [YearNum] = " & Me.YearNum & " AND [WeekNum] = " & Me.WeekNum & ""
Debug.Print sSQL
CurrentDb.Execute sSQL
Else
Debug.Print "Executing Update for null DLookup element in PartNum select query"
sSQL = "INSERT INTO [Inventory] " _
& "VALUES ('" & rs!UsedPartNum & "'," & Me.YearNum & "," & Me.WeekNum & ",0," & num & ")"
Debug.Print sSQL
CurrentDb.Execute sSQL
End If
rs.MoveNext
Loop
End If
rs.Close
Set rs = Nothing
End Select
End Select
In this case you should study your Immediate windows (openes by Ctrl + G) to see, what is the execution plan, and what SQL texts are generated, and check all of them.
Otherwise, there is too many your business specific logics in this code, and it is quite impossible to understand program behavior. Maybe such behavior is assumpted, due to business logics? Many, many questions

Hit the F9 key over, and over, and over, until you see what the problem is. Also, leverage 'Add Watch' to see what values are passed to which variables. That should help immensely. Finally, if this is done by a professional, why are you using: 'Command96_Click()'? Of course that's not the problem, but it's not helping either.

Run Time Error 3078 when table name is correct

I've checked a few articles related to this with no answer working to solve my own issue.
I'm trying to duplicate all records in tbl_MBR_MiscSteps having value:
CO = Forms!frm_BP10_Tablet_MBR_Process!CO
And changing it to:
Forms!frm_BP10_Tablet_ViewMBR!TxtSaveAs.
I keep getting cannot find '|1' field in criteria expression and when I try the immediate window, I get error
3078: Input table not found.
I also checked ?currentdb.TableDefs("tbl_MBR_MiscSteps").Name and got tbl_MBR_MiscSteps
Can someone please tell me what my code is missing?
Private Sub Command617_Click()
Dim sSQL As String
q2 = Chr$(34) & Chr$(34)
dq = Chr$(34) 'double quotes
sSQL = "INSERT INTO tbl_MBR_MiscSteps (CO, Step, Tank, RawMaterial, Weight,
Amount, QuantityWeighed, QuantityDispensed, ScaleID, StartingAmount, " _
& "StartingAmountxBCoatingSolutionNeeded, ContainerTankID,
NitrogenIsFlowing, Screen, StartTime, StopTime, CompletedByDate,
CheckedByDate, CommentsBy) SELECT " _
& dq & Replace(Nz([TxtSaveAs]), dq, q2) & dq & "," _
& dq & Replace(Nz([Step]), dq, q2) & dq & "," _
& dq & Replace(Nz([Tank]), dq, q2) & dq & "," _
& dq & Replace(Nz([RawMaterial]), dq, q2) & dq & "," _
& dq & Replace(Nz([Weight]), dq, q2) & dq & "," _
& dq & Replace(Nz([Amount]), dq, q2) & dq & "," _
& dq & Replace(Nz([QuantityWeighed]), dq, q2) & dq & "," _
& dq & Replace(Nz([QuantityDispensed]), dq, q2) & dq & "," _
& dq & Replace(Nz([ScaleID]), dq, q2) & dq & "," _
& dq & Replace(Nz([StartingAmount]), dq, q2) & dq & "," _
& dq & Replace(Nz([StartingAmountxBCoatingSolutionNeeded]), dq, q2) & dq & "," _
& dq & Replace(Nz([ContainerTankID]), dq, q2) & dq & "," _
& dq & Replace(Nz([NitrogenIsFlowing]), dq, q2) & dq & "," _
& dq & Replace(Nz([Screen]), dq, q2) & dq & "," _
& dq & Replace(Nz([StartTime]), dq, q2) & dq & "," _
& dq & Replace(Nz([StopTime]), dq, q2) & dq & "," _
& dq & Replace(Nz([CompletedByDate]), dq, q2) & dq & "," _
& dq & Replace(Nz([CheckedByDate]), dq, q2) & dq & "," _
& dq & Replace(Nz([CommentsBy]), dq, q2) & dq & "," _
& "FROM tbl_MBR_MiscSteps " _
& "WHERE CO = Forms!frm_BP10_Tablet_MBR_Process!CO"
CurrentDb.Execute sSQL, dbFailOnError
End Sub

You could try something like this (completed untested):
Private Sub Command617_Click()
Dim sSQL As String
sSQL = sSQL & "INSERT INTO "
sSQL = sSQL & " tbl_MBR_MiscSteps "
sSQL = sSQL & " ("
sSQL = sSQL & " CO, Step, Tank, RawMaterial, Weight, Amount , QuantityWeighed, QuantityDispensed, "
sSQL = sSQL & " ScaleID, StartingAmount, StartingAmountxBCoatingSolutionNeeded, ContainerTankID, "
sSQL = sSQL & " NitrogenIsFlowing, Screen, StartTime, StopTime, CompletedByDate, CheckedByDate, CommentsBy"
sSQL = sSQL & " ) "
sSQL = sSQL & "SELECT"
sSQL = sSQL & " "" & Replace(Nz([TxtSaveAs]), "", """") & "","
sSQL = sSQL & " "" & Replace(Nz([Step]), "", """") & "","
sSQL = sSQL & " "" & Replace(Nz([Tank]), "", """") & "","
sSQL = sSQL & " "" & Replace(Nz([RawMaterial]), "", """") & "","
sSQL = sSQL & " "" & Replace(Nz([Weight]), "", """") & "","
sSQL = sSQL & " "" & Replace(Nz([Amount]), "", """") & "","
sSQL = sSQL & " "" & Replace(Nz([QuantityWeighed]), "", """") & "","
sSQL = sSQL & " "" & Replace(Nz([QuantityDispensed]), "", """") & "","
sSQL = sSQL & " "" & Replace(Nz([ScaleID]), "", """") & "","
sSQL = sSQL & " "" & Replace(Nz([StartingAmount]), "", """") & "","
sSQL = sSQL & " "" & Replace(Nz([StartingAmountxBCoatingSolutionNeeded]), "", """") & "","
sSQL = sSQL & " "" & Replace(Nz([ContainerTankID]), "", """") & "","
sSQL = sSQL & " "" & Replace(Nz([NitrogenIsFlowing]), "", """") & "","
sSQL = sSQL & " "" & Replace(Nz([Screen]), "", """") & "","
sSQL = sSQL & " "" & Replace(Nz([StartTime]), "", """") & "","
sSQL = sSQL & " "" & Replace(Nz([StopTime]), "", """") & "","
sSQL = sSQL & " "" & Replace(Nz([CompletedByDate]), "", """") & "","
sSQL = sSQL & " "" & Replace(Nz([CheckedByDate]), "", """") & "","
sSQL = sSQL & " "" & Replace(Nz([CommentsBy]), "", """") & "" "
sSQL = sSQL & "FROM"
sSQL = sSQL & " tbl_MBR_MiscSteps "
sSQL = sSQL & "WHERE"
sSQL = sSQL & " CO = Forms!frm_BP10_Tablet_MBR_Process!CO"
CurrentDb.Execute sSQL, dbFailOnError
End Sub

ADODB recordset SQL returns error in Excel VBA

The following code produces an error (Method 'Open' of object'_Recordset' failed) when I get to the statement that tries to open the recordset:
Set objClubSalesSourceConn = CreateObject("ADODB.COnnection")
objClubSalesSourceConn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & strDirectory & ";" & _
"Extended Properties=""text;HDR=YES;FMT=Delimited"""
Set rsClubOrders = CreateObject("ADODB.Recordset")
strSQL = "SELECT"
strSQL = strSQL & vbCrLf & " ClubSales.[Order Number] AS OrderNum,"
strSQL = strSQL & vbCrLf & " ClubSales.[Submitted Date] AS SaleDate,"
strSQL = strSQL & vbCrLf & " ClubSales.[Product SKU] AS SKU,"
strSQL = strSQL & vbCrLf & " ClubSales.[Product Name] AS ItemDesc,"
strSQL = strSQL & vbCrLf & " ClubSales.[Ext Item Price] AS SaleAmt,"
strSQL = strSQL & vbCrLf & " ClubSales.[Ext Item Shipping] AS ShipAmt,"
strSQL = strSQL & vbCrLf & " CASE WHEN ISNULL(ClubSales.[Ship Date])"
strSQL = strSQL & vbCrLf & " THEN 1"
strSQL = strSQL & vbCrLf & " ELSE 0 END AS ShipDateNull,"
strSQL = strSQL & vbCrLf & " ClubSales.[Ship Date] AS ShipDate,"
strSQL = strSQL & vbCrLf & " ClubSales.[Pickup Date] AS PickupDate,"
strSQL = strSQL & vbCrLf & " ClubSales.[Quantity Sold] * ClubSales.[Cost Of Goods] AS COGSAmt"
strSQL = strSQL & vbCrLf & "FROM"
strSQL = strSQL & vbCrLf & " ClubSalesSource.csv AS ClubSales"
rsClubOrders.Open strSQL, objClubSalesSourceConn, adOpenDynamic*
The problem lies in the CASE WHEN statement in the SQL. If I leave that out, the recordset opens okay. I am in Excel VBA, querying a csv file. I need to know how to fix this. I have also unsuccessfully tried using an IIF function like I have done in Access.

strSQL = "SELECT" & _
" ClubSales.[Order Number] AS OrderNum," & _
" ClubSales.[Submitted Date] AS SaleDate," & _
" ClubSales.[Product SKU] AS SKU," & _
" ClubSales.[Product Name] AS ItemDesc," & _
" ClubSales.[Ext Item Price] AS SaleAmt," & _
" ClubSales.[Ext Item Shipping] AS ShipAmt," & _
" CASE WHEN ISNULL(ClubSales.[Ship Date])" & _
" THEN 1" & _
" ELSE 0 END AS ShipDateNull," & _
" ClubSales.[Ship Date] AS ShipDate," & _
" ClubSales.[Pickup Date] AS PickupDate," & _
" ClubSales.[Quantity Sold] * ClubSales.[Cost Of Goods] AS COGSAmt" & _
" FROM" & _
" ClubSalesSource.csv AS ClubSales"

Runtime Error 3065 "Cannot execute a select query" in VBA SQL statement

I'm having some problems with a VBA script I'm creating and I thought here would be the best place to ask. I will give some background:
I am writing this program as a lot of my clients go against the regular issued documents from my countries tax office and pay cash in hand, and then get me to calculate the amount of tax on that particular amount. It is a fair bit of paperwork figuring that out manually, so I am writing an application that does this, and a fair amount more. The script below is at the heart of what needs to be done.
For the first use case I have essentially created a single-use form in Access - nothing is written, it is just for a temporary calculation and being sent to the printer - to calculate holiday pay.
As I cannot perform a SQL lookup in a calculated cell, I am running a VBA script to do the heavy lifting for me, passing the three entered values as arguments.
However, I cannot seem to get rid of runtime error 3075, and I cannot for the life of me figure out where it is coming from. I have traced it down to the SQL statement but I can't find where there would be an operator error. Where am I going wrong?
Here is the code:
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
Of course if there is any further questions I'll be around to answer them.
Thanks!
EDIT: Urgh, I've been looking at this code for too long. The ROUND function needed to be encapsulated in brackets. That got rid of error 3075. I have amended my code above to where it is now.
However now I am receiving error 3065 "Cannot execute a select query". With some preliminary Googling it seems that I cannot use a SELECT field in a form, but I don't think that should make a difference as I am calling it in a module. I will attempt further tomorrow as I am off to bed, but in the meantime does anybody have any ideas?

I ended up solving my problem during the week. I believe the problems were a) the way dates were handled and b) missing quotation marks.
This also includes the code that I have that a) called the function in question and b) appended it to a table.
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
Actual tax function...
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