I have the following code in VBA:
Dim strSQL As String
strSQL = "UPDATE Workstations SET MID = newvalue WHERE MID = tempvalue"
DoCmd.RunSQL strSQL
newvalue and tempvalue are both global variables and have already been set values. Syntax wise, does this make sense? or am I missing quotation marks?
Try this one:
If MID is number:
Dim strSQL As String
strSQL = "UPDATE Workstations SET [MID] = " & newvalue & " WHERE [MID] = " & tempvalue
DoCmd.RunSQL strSQL
If MID is string (if newvalue/tempvalue doesn't contain single quote '):
Dim strSQL As String
strSQL = "UPDATE Workstations SET [MID] = '" & newvalue & "' WHERE [MID] = '" & tempvalue & "'"
DoCmd.RunSQL strSQL
If MID is string (if newvalue/tempvalue contains single quote ' like newvalue="Mike's car"):
Dim strSQL As String
strSQL = "UPDATE Workstations SET [MID] = '" & Replace(newvalue, "'", "''") & "' WHERE [MID] = '" & Replace(tempvalue, "'", "''") & "'"
DoCmd.RunSQL strSQL
If MID is date:
Dim strSQL As String
strSQL = "UPDATE Workstations SET [MID] = #" & newvalue & "# WHERE [MID] = #" & tempvalue & "#"
DoCmd.RunSQL strSQL
Thanks to #HansUp for pointing out in comments, that
MID is the name of a function, so it would be safer to bracket or alias that field name in the SQL statement: SET [MID]
Related
I created an Access database to track work orders and create/print schedules.
On the report I have two different print buttons. One prints the weeks schedule I'm currently viewing to my printer and the other button prints the current week and all future weeks to a PDF. My code for the 2nd button changes the SQL data source and works perfect.
That code looks like this (see pic):
Working SQL code
-----Set default printer to PDF-----
-working code-
-----Set the datasource to show everything from this week and future weeks excluding unscheduled (NULL)-----
Dim strSQL As String
Dim vbDblQuote As String
'set variable to = "
vbDblQuote = Chr(34)
'SQL for the data source
strSQL = "SELECT tblSchedule.ScheduleID, tblSchedule.Scheduled, tblSchedule.Attending, "
strSQL = strSQL & "tblSchedule.Time, tblSchedule.Account, tblSchedule.Address , "
strSQL = strSQL & "tblSchedule.Comments, tblSchedule.Contact, tblSchedule.WONumber "
strSQL = strSQL & "FROM tblSchedule "
strSQL = strSQL & "WHERE (((DatePart(" & vbDblQuote & "ww" & vbDblQuote & ",[Scheduled])) "
strSQL = strSQL & ">=DatePart(" & vbDblQuote & "ww" & vbDblQuote & ",Date()))"
strSQL = strSQL & "AND ((Year([Scheduled]))>=Year(Date())))"
strSQL = strSQL & "ORDER BY tblSchedule.Scheduled, tblSchedule.Attending, tblSchedule.Time;"
'set data source for the report
Reports![rptSchedule].Report.RecordSource = strSQL
-----Print and restore default printer-----
-working code-
Now I want to enable the user to select an end date for the report. I changed the code every which way I could but can't get it to work now. Can anyone help me with the new SQL? It contains a variable to accept the users date.
The new code looks like this (see pic): New Code
-----Set default printer to PDF-----
-working code-
-----Get the end date from user-----
Dim endDate
endDate = InputBox("Select an End Date m/d/yy")
-----Set the datasource to show everything from this week and future weeks excluding unscheduled (NULL)-----
Dim strSQL As String
Dim vbDblQuote As String
'set variable to = "
vbDblQuote = Chr(34)
Dim mySQLVariable
'set variable to user’s end date
mySQLVariable = endDate
'SQL for the data source
strSQL = "SELECT tblSchedule.ScheduleID, tblSchedule.Scheduled, tblSchedule.Attending, "
strSQL = strSQL & "tblSchedule.Time, tblSchedule.Account, tblSchedule.Address , "
strSQL = strSQL & "tblSchedule.Comments, tblSchedule.Contact, tblSchedule.WONumber "
strSQL = strSQL & "FROM tblSchedule "
strSQL = strSQL & "WHERE (((DatePart(" & vbDblQuote & "ww" & vbDblQuote & ",[Scheduled])) "
strSQL = strSQL & ">=DatePart(" & vbDblQuote & "ww" & vbDblQuote & ",Date()))"
strSQL = strSQL & "AND ((Year([Scheduled]))>=Year(Date())))"
strSQL = strSQL & "OR (((DatePart(" & vbDblQuote & "ww" & vbDblQuote & ", [Scheduled])) "
strSQL = strSQL & "<= DatePart(" & vbDblQuote & "ww" & vbDblQuote & ", Date() + '" & (mySQLVariable) & "')) "
strSQL = strSQL & "And ((Year([Scheduled])) = Year(Date() + '" & (mySQLVariable) & "'))) "
strSQL = strSQL & "ORDER BY tblSchedule.Scheduled, tblSchedule.Attending, tblSchedule.Time;"
'set data source for the report
Reports![Reset_Schedule].Report.RecordSource = strSQL
-----Print and restore default printer-----
-working code-
I hope this is clear enough to understand my problem.
I'm new to Access and i'm having trouble with comparing dates in my SQL Query. I can't seem to work around this problem. It works fine if it just input a date like this:
Dim SendTo as string, strSQL as string
DateF = Me.txtDate.value
strSQL = "UPDATE [" & Team & "] SET [" & Init & "] = '" & SendTo & "' WHERE Date = #2020-01-06#;"
I want the date to be a variable set by a textbox on a userform, like this:
strSQL = "UPDATE [" & Team & "] SET [" & Init & "] = '" & SendTo & "' WHERE Date = DateF"
DoCmd.RunSQL strSQL
When i do this, a pop-up box show "Enter parameter value"
Hope you can help - I'm having issues getting the last ID after INSERT.
So the environment - Access 2016, SQL Server and VBA
Dim db As DAO.Database
Dim RS As New ADODB.Recordset
Dim sql As String
I have theses declared and then private sub.
Private Sub CreateOrderHeader()
Dim CustomerID As Integer
Dim OrderDate As String
Dim OrderStatus As String
Dim OrderValue As Double
Dim OrderNotes As String
Dim OrderPostageID As String
Dim OrderAddressID As String
Dim OrderBatchID As Integer
Dim OrderPayment As String
Dim OrderCourierID As String
Dim OrderAgentID As Integer
Dim OrderOutstanding As Double
CustomerID = tbxCusID
OrderDate = Format(Now)
OrderStatus = "InProcess"
OrderValue = txtTotal.value
OrderNotes = tbxNotes.value
OrderPostageID = txtPostage.Column(0)
If tbxCustomerAddress = tbxDeliveryAddress Then
OrderAddressID = 3 'default customers address
Else
'NEED TO GET CUSTOMER ADDRESS TO DO
End If
OrderBatchID = cmbBatch.Column(0)
OrderPayment = sPayMethod
OrderCourierID = cbxShipping.Column(0)
OrderAgentID = 0
OrderOutstanding = txtTotal.value
Dim testvar As String
sql = "INSERT INTO dbo_OrderHeader " _
& "(OrdCusID, OrdDate, OrdStatus, OrdValue, OrdNotes, OrdPostageID, OrdDelAddID,OrdBatchID,OrdPaymentMethod, OrdCourierID,ordAgentID, OrdOutstanding,OrdSource) " _
& " VALUES ('" & CustomerID & "' ,'" & OrderDate & "', '" & OrderStatus & "', '" & OrderValue & "', '" & OrderNotes & "', '" & OrderPostageID & "','" & OrderAddressID & "','" & OrderBatchID & "','" & OrderPayment & "','" & OrderCourierID & "','" & OrderAgentID & "','" & OrderOutstanding & "', 1)"
DoCmd.RunSQL (sql)
sql = "SELECT ##IDENTITY As IDT"
RS.Open sql, CurrentProject.Connection, adOpenStatic, adLockReadOnly
IDT = RS!IDT
MsgBox ("Succes - OrderHeader" & " '" & IDT & "' ")
End Sub
I was expecting a result from this code:
sql = "SELECT ##IDENTITY As IDT"
RS.Open sql, CurrentProject.Connection, adOpenStatic, adLockReadOnly
IDT = RS!IDT
But that gives me "0" as result.
Can you help please.
Thanks
You can try this :
Set db = CurrentDB
db.Execute(sql)
IDT = db.OpenRecordset("SELECT ##IDENTITY")(0)
Set db = Nothing
NOTE
Don't execute your insert query like DoCmd.RunSQL (sql) Instead follow the above approach.
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
I have been racking my brain with searching on the internet for the solution, but to no avail, I have been unsuccessful.
strSQL = "Update tTbl_LoginPermissions SET LoginName = '" & StrUserName & "', PWD = '" & StrPWD & "', fldPWDDate = '" & Now() & "'" & _
"WHERE intLoginPermUserID = " & MyMSIDColumn0
Once I get the error out, I would like to actually use this where clause:
'WHERE intLoginPermUserID IN (SELECT intCPIIUserID From vw_ADMIN_Frm_LoginBuilder)
Here is the entire code:
Dim con As ADODB.Connection
Dim cmd As ADODB.Command
Dim strSQL As String
Const cSQLConn = "DRIVER=SQL Server;SERVER=dbswd0027;UID=Mickey01;PWD=Mouse02;DATABASE=Regulatory;"
Dim StrUserName As String, StrPWD As String
'passing variables
StrUserName = FindUserName()
StrPWD = EncryptKey(Me.TxtConPWD)
'Declaring the SQL expression to be executed by the server
strSQL = "Update tTbl_LoginPermissions SET LoginName = '" & StrUserName & "', PWD = '" & StrPWD & "', fldPWDDate = '" & Now() & "#" & _
"WHERE intLoginPermUserID = " & MyMSIDColumn0
'WHERE intLoginPermUserID = ANY (SELECT intCPIIUserID From vw_ADMIN_Frm_LoginBuilder)
Debug.Print strSQL
'connect to SQL Server
Set con = New ADODB.Connection
With con
.ConnectionString = cSQLConn
.Open
End With
'write back
Set cmd = New ADODB.Command
With cmd
.ActiveConnection = con
.CommandText = strSQL
.CommandType = adCmdText
.Execute
Debug.Print strSQL
End With
'close connections
con.Close
Set cmd = Nothing
Set con = Nothing
MsgBox "You password has been set", vbInformation + vbOKOnly, "New Password"
NEWEST CODE Producing Error:
'/Declaring the SQL expression to be executed by the server
strSQL = "Update dbo_tTbl_LoginPermissions " _
& "SET LoginName = '" & StrUserName & "' " _
& "SET PWD = '" & StrPWD & "' " _
& "SET fldPWDDate = '" & Now() & "' " _
& "WHERE intLoginPermUserID = 3;"
I have gone to this site to try to figure out my mistake, but I still cannot figure it out:
After much dilberation and help, it turns out the FindUserName that utilizes a Win32API function was not trimming the Username appropriately.
I changed it to the following:
Public Function FindUserName() As String
' This procedure uses the Win32API function GetUserName
' to return the name of the user currently logged on to
' this machine. The Declare statement for the API function
' is located in the Declarations section of this module.
Dim strBuffer As String
Dim lngSize As Long
strBuffer = Space$(255)
lngSize = Len(strBuffer)
If GetUserName(strBuffer, lngSize) = 1 Then
FindUserName = Left$(strBuffer, lngSize - 1)
Else
FindUserName = "User Name not available"
End If
End Function
Public Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Try this:
strSQL = "Update tTbl_LoginPermissions SET LoginName = '" & replace(StrUserName, "'", "''") & "', PWD = '" & replace(StrPWD, "'", "''") & "', fldPWDDate = '" & Now() & "'" & _
"WHERE intLoginPermUserID = " & MyMSIDColumn0
This was inevitably the code that corrected my (') mystery:
'/passing variables
StrUserName = FindUserName()
StrPWD = EncryptKey(Me.TxtConPWD)
StrUserId = Me.CboUser.Column(0)
'/Declaring the SQL expression to be executed by the server
strSQL = "Update tTbl_LoginPermissions SET " _
& "LoginName = '" & StrUserName & "' , " _
& "PWD = '" & StrPWD & "' ," _
& "fldPWDDate = '" & Now() & "' " _
& "WHERE intLoginPermUserID = '" & StrUserId & "'"