Update a Table field with current time - vba

Good day all,
I have a unbounded form with a subform (its data source is a table named SaleDetail).
On the Main Form there is a text box for the Sales ID also unbounded.
I have created a button with the following code:
Private Sub btnEndSale_Click()
Dim strPostTime As String
strPostTime = "UPDATE SaleDetail " & _
"SET [TIMEOUT] = Time()" & _
"WHERE SaleDetail.SID = Forms!Sales.Form.sSID"
DoCmd.SetWarnings False
DoCmd.RunSQL strSQL
DoCmd.SetWarnings True
DoCmd.Requery
End Sub
I am trying to get the current time to update the records in the SalesDetail table once the SID on the Main Form matches the SID in the SalesDetail Table but it is not working, but if I substitute Forms!Sales.Form.sSID with an existing ID (eg 9) it works. Any help will be appreciated.

SetWarnings False suppresses information, so can be an obstacle to trouble-shooting. And it can be totally avoided with a parameter query.
Dim db As DAO.Database
Dim qdf As DAO.QueryDef
Dim strUpdate As String
strUpdate = "UPDATE SaleDetail SET [TIMEOUT] = Time() " & _
"WHERE SaleDetail.SID = which_SID;"
Set db = CurrentDb
Set qdf = db.CreateQueryDef(vbNullString, strUpdate)
With qdf
.Parameters("which_SID").Value = Forms!Sales.Form.sSID.Value
.Execute dbFailOnError
End With
MsgBox db.RecordsAffected & " records updated"

Try this:
strPostTime = "UPDATE SaleDetail " & _
"SET [TIMEOUT] = Time()" & _
"WHERE SaleDetail.SID = " & Forms!Sales.Form.sSID

I think that newbieDBBuilder is not asking about SQL Server query which could use parameters. His code is:
DoCmd.RunSQL strSQL
which is MS Access command and queries Access db.

Related

Access VBA run query with values passed from a list box

I have made this form in Access and I am hoping to do the following task.
The list box here contains two columns, and can be multi-selected. I want to use the values second column (the right column) and pass them into a query that I set up for the "test2" button below.
And here is my VBA code for the on-click event for the button.
Private Sub test2_Click()
Dim db As dao.Database
Dim qdef As dao.QueryDef
Dim strSQL As String
Set db = CurrentDb
'Build the IN string by looping through the listbox
For i = 0 To Select_Counties2.ListCount - 1
If Select_Counties2.Selected(i) Then
strIN = strIN & "'" & Select_Counties2.Column(1, i) & "',"
End If
Next i
'Create the WHERE string, and strip off the last comma of the IN string
strWhere = " WHERE County_GEOID in " & "(" & Left(strIN, Len(strIN) - 1) & ")"
strSQL = strSQL & strWhere
Set qdef = db.CreateQueryDef("User query results", strSQL)
qdef.Close
Set qdef = Nothing
Set db = Nothing
DoCmd.OpenQuery "User query results", acViewNormal
End Sub
I was getting this error:
Can someone tell me what I did wrong in the code? Thank you!
In this example from microsoft they call application.refreshwindow without explanation.
https://learn.microsoft.com/en-us/office/client-developer/access/desktop-database-reference/database-createquerydef-method-dao
What I think is going on is that your code fails because access cannot find the query that was just added to it's collection of queries. Also your generated sql is no longer valid.
So: replace my sql with your own valid sql
Private Sub test2_Click()
Dim db As DAO.Database
Dim qdef As DAO.QueryDef
Dim strSQL As String
strSQL = "PARAMETERS GEOID Number; " 'without valid sql this code doesn't run so
'replace my sql with your own.
strSQL = strSQL & "SELECT GEOID FROM Counties"
Set db = CurrentDb
For i = 0 To Select_Counties2.ListCount - 1
If Select_Counties2.Selected(i) Then
strIN = strIN & Select_Counties2.Column(1, i) & ","
End If
Next i
strWhere = " WHERE County_GEOID in " & "(" & Left(strIN, Len(strIN) - 1) & ")"
strSQL = strSQL & strWhere
Debug.Print strSQL
'now the important bit:
db.CreateQueryDef ("User query results") 'create the query
Application.RefreshDatabaseWindow 'refresh database window so access knows it has a new query.
'query will now be visible in database window. make sure to delete the query between runs
'Access will throw an error otherwise
Set qdef = db.QueryDefs("User query results")
qdef.SQL = strSQL
qdef.Close
Set qdef = Nothing
Set db = Nothing
DoCmd.OpenQuery "User query results", acViewNormal
End Sub

Difficulty using SELECT statement in VBA

I'm trying to set command buttons to enter data into a table. If the record already exists I want the button to update it, and if it does not the button needs to create it. Here's a sample of what the table looks like
ID scenarioID reductionID Impact Variable Variable Impact
1 1 1 Safety 4
2 1 1 Environmental 2
3 1 1 Financial 1
In order to accurately locate records, it needs to search for the specific impact variable paired with the scenarioID. I'm trying to use a select statement, but DoCmd.RunSQL doesn't work for select statements, and I'm not sure how else to do it.
Here's the code. I left DoCmd.SQL in front of the select statement for lack of anything else to place there for now.
Private Sub Var1R1_Click() 'Stores appropriate values in tImpact upon click
'Declaring database and setting recordset
Dim db As Database
Dim rs As Recordset
Set db = CurrentDb
Set rs = db.OpenRecordset("tImpact")
'Declaring Variable as Scenario Choice combobox value
Dim Sc As Integer
Sc = Schoice.Value
'Stores impact variable
Dim impvar1 As String
'Desired impact variable for column 1
impvar1 = DLookup("impactVariable", "tImpactVars", "ID = 1")
DoCmd.RunSQL "SELECT * FROM tImpact WHERE [Impact Variable] = " & impvar1 & " AND scenarioID = " & Sc
If rs.EOF Then
DoCmd.RunSQL "INSERT INTO tImpact(scenarioID, [Impact Variable], [Variable Impact])" & "VALUES (" & Sc & ", " & impvar1 & ", 1)"
MsgBox "Record Added", vbOKOnly
Else
db.Execute "UPDATE tImpact SET [Variable Impact] = 1 WHERE [Impact Variable] = " & impvar1 & " AND scenarioID = " & Sc
MsgBox "Record Updated", vbOKOnly
End If
End Sub
If anyone can tell me how to get that SELECT statement to run, or another way of doing this, that would be great.
Any help is greatly appreciated!
You can use a recordset. In this case a recordset is better, since you only execute the SQL one time, if it returns a record, you "edit" and if not then you "add" with the SAME reocrdset. This approach is FAR less code, and the values you set into the reocrdset does not require messy quotes or delimiters etc.
eg:
scenaridID = 1 ' set this to any number
impvar1 = "Safety" ' set this to any string
updateTo = "Financial"
strSQL = "select * from tImpact where [Impact Variable] = '" & impvar1 & "'" & _
" AND scenaridID = " & scenaridID
Set rst = CurrentDb.OpenRecordset(strSQL)
With rst
If .RecordCount = 0 Then
' add the reocrd
.AddNew
Else
.Edit
End If
!scenaridID = scenarid
![Impact Variable] = impvar1
![Variable Impact] = 1
.Update
End With
rst.Close
So you can use the same code for the update and the edit. It just a question if you add or edit.
Use OpenRecordset and retrieve the ID for the record if it exists.
Private Sub Command0_Click()
Dim aLookup(1 To 3) As String
Dim aAction(1 To 3) As String
Dim rs As Recordset
Dim db As Database
'Replace these two constants with where you get the information on your form
Const sIMPVAR As String = "Financial"
Const lSCENID As Long = 1
'Build the SQL to find the ID if it exists
aLookup(1) = "SELECT ID FROM tImpact"
aLookup(2) = "WHERE ScenarioID = " & lSCENID
aLookup(3) = "AND ImpactVariable = """ & sIMPVAR & """"
'Run the sql to find the id
Set db = CurrentDb
Set rs = db.OpenRecordset(Join(aLookup, Space(1)))
If rs.BOF And rs.EOF Then 'it doesn't exist, so build the insert statement
aAction(1) = "INSERT INTO tImpact"
aAction(2) = "(ScenarioID, ImpactVariable, VariableImpact)"
aAction(3) = "VALUES (" & lSCENID & ", '" & sIMPVAR & "', 1)"
Else 'it does exist, so build the update statement
aAction(1) = "UPDATE tImpact"
aAction(2) = "SET VariableImpact = 1"
aAction(3) = "WHERE ID = " & rs.Fields(0).Value
End If
'Run the action query
db.Execute Join(aAction, Space(1))
rs.Close
Set rs = Nothing
Set db = Nothing
End Sub

Error 3075-Run Query after multi select listbox is utilized

have a search form in Access 2010 that filters FYs and Quarters based on certain criteria and opens them in a query. One of the criteria is an unbound multi-select list box, SelectTime (Where a person selects "FY15-Q1 and FY15 Q2, for example. The data are stored in a query, z_Basis_QSReport5_Proposal Details. I keep getting an error 3075. Can someone help me with the code?
Private Sub Command56_Click()
Dim db As DAO.Database
Dim qdf As DAO.QueryDef
Dim varItem As Variant
Dim strCriteria As String
Dim strSQL As String
Set db = CurrentDb()
Set qdf = db.QueryDefs("z_Basis_QSReport5_Proposal Details_For_Report")
For Each varItem In Me!SelectTime.ItemsSelected
strCriteria = strCriteria & ",'" & Me!SelectTime.ItemData(varItem) & "'"
Next varItem
If Len(strCriteria) = 0 Then
MsgBox "You did not select anything from the list" _
, vbExclamation, "Nothing to find!"
Exit Sub
End If
strCriteria = Right(strCriteria, Len(strCriteria) - 1)
strSQL = "SELECT * FROM z_Basis_QSReport5_Proposal Details " & _
"WHERE z_Basis_QSReport5_Proposal Details.CriteriaFY IN(" & strCriteria & ");"
qdf.SQL = strSQL
DoCmd.OpenQuery "z_Basis_QSReport5_Proposal Details_For_Report"
Set db = Nothing
Set qdf = Nothing
End Sub
I agree with #LiamH that you need to surround your query names with square brackets.
Also it looks like you're trying to change the SQL of a query on the fly - and then call the query before you've saved the changes
qdf.SQL = strSQL
**qdf.close**
DoCmd.OpenQuery "z_Basis_QSReport5_Proposal Details_For_Report"
That being said I think you should be looking at parameter queries or just opening the SQL directly.
When creating query, table, and field names; it is best practice to avoid spaces. However, there is a solution.
When you use SQL and you have a table name with spaces you need to encapsulate it in square brackets. like so:
"SELECT * FROM [z_Basis_QSReport5_Proposal Details] & _
"WHERE [z_Basis_QSReport5_Proposal Details].CriteriaFY .....
EDIT
Before, I mentioned that you should maybe put square brackets around the query name, but if you look at the example here you will see that spaces are acceptable in this instance.
If we go back to your query, strcriteria is a string and therefore you need to put single quotes around it:
strSQL = "SELECT * FROM [z_Basis_QSReport5_Proposal Details] " & _
"WHERE [z_Basis_QSReport5_Proposal Details].CriteriaFY IN('" & strCriteria & "');"
Also, you will need to close your query before you can run it. So qdf.close is required before the docmd.openquery().

Update Microsoft Access Table Field from Excel App Via VBA/SQL

I am successfully able to connect to database, but the problem is when it updates table field. It updates the entire field in table instead of searching for ID number and only updating that specific Time_out Field. Here is the code below, I must be missing something, hopefully something simple I have overlooked.
Sub UpdateAccessDatabase()
Dim accApp As Object
Dim SQL As String
Dim id
id = frm2.lb.List(txt)
SQL = "UPDATE [Table3] SET [Table3].Time_out = " & "Now()" & " WHERE "
SQL = SQL & "((([Table3].ID)=id));"
Set accApp = CreateObject("Access.Application")
With accApp
.OpenCurrentDatabase "C:\Signin-Database\DATABASE\Visitor_Info.accdb"
.DoCmd.RunSQL SQL
.Quit
End With
Set accApp = Nothing
End Sub
In case the id is integer/long, you should modify the query as following:
SQL="UPDATE [Table3] SET [Table3].Time_out=#" & Now() & "# WHERE [Table3].ID=" & id;
In case the id is a text, you should modify the query as following:
SQL="UPDATE [Table3] SET [Table3].Time_out=#" & Now() & "# WHERE [Table3].ID='" & id &"'";
Hope this may help.
Here is the working Code below:
Sub UpdateAccessDatabase()
Dim accApp As Object
Dim SQL As String
Dim id
id = frm2.lb.List(txt)
***'modified lines below***
SQL = "UPDATE [Table3] SET [Table3].Time_out = " & "Now()" & " WHERE "
SQL = SQL & "((([Table3].ID)=" & id & "));"
Set accApp = CreateObject("Access.Application")
With accApp
.OpenCurrentDatabase "C:\Signin-Database\DATABASE\Visitor_Info.accdb"
.DoCmd.RunSQL SQL
.Quit
End With
Set accApp = Nothing
End Sub
#alex
I was able to modify the query to your above mentioned SQL statement
i did have to remove a few (#,') from the statement in order for it work, but this is much cleaner
so here is another working example below
`Sub UpdateAccessDatabase()
Dim accApp As Object
Dim SQL As String
Dim id
id = frm2.lb.List(txt)
***'modified lines below***
SQL = "UPDATE [Table3] SET [Table3].Time_out= " & "Now()" & " WHERE [Table3].ID=" & id & ""
Set accApp = CreateObject("Access.Application")
With accApp
.OpenCurrentDatabase "C:\Signin-Database\DATABASE\Visitor_Info.accdb"
.DoCmd.RunSQL SQL
.Quit
End With
Set accApp = Nothing
End Sub`

Access VBA query to SQL Server

Hello experts I'm having trouble in my update query from SQL Server. Running first a select query then pass the result to currentdb.execute (to update the table of the access file currently using), using Access vba I'm not doing it right. I really hope you could help me. Maybe you guys know much better way to run my procedure:
connect to sql server 2008, run select query.
pass the result of select query to an access database execute command (or if you have a better idea) to update a table in the current access file that is using.
The error I'm getting to the code is Type mismatch and highlighting .OpenSchema.
These is part of the code that I made wrong (and I really have no idea how to do this).
dbObj.Execute ("UPDATE ACCESS.tbl_Name RIGHT JOIN " & _
conn.OpenSchema(adSchemaTables, Array(Empty, Empty, Empty, "SQLSVR.tbl_Name")) & _
" ON ACCESS.tbl_Name.FieldName_access = " & rst!FieldName_sqlsvr & _
" SET ACCESS.tbl_Name.FieldName_access = " & rst!FieldName_sqlsvr)
These is the whole code.
Option Compare Database
Sub LocalSQLServerConn_Test()
Dim dbOjb As DAO.Database
Dim strDBName As String
Dim strUserName As String
Dim strPassword As String
Set dbObj = CurrentDb()
Set conn = New adodb.Connection
Set rst = New adodb.Recordset
strDBName = "DataSet"
strConnectString = "Provider = SQLOLEDB.1; Integrated Security = SSPI; " & _
"Initial Catalog = " & strDBName & "; Persist Security Info = True; " & _
"Workstation ID = ABCDE12345;"
conn.ConnectionString = strConnectString
conn.Open
strSQL = "SELECT DISTINCT SQLSVR.tbl_Name.FieldName_sqlsvr FROM SQLSVR.tbl_Name"
rst.Open Source:=strSQL, ActiveConnection:=conn, _
CursorType:=adOpenDynamic, LockType:=adLockOptimistic
If rst.RecordCount = 0 Then
MsgBox "No records returned"
Else
rst.MoveFirst
Do While Not rst.EOF
dbObj.Execute ("UPDATE ACCESS.tbl_Name RIGHT JOIN " & _
conn.OpenSchema(adSchemaTables, Array(Empty, Empty, Empty, "SQLSVR.tbl_Name")) & _
" ON ACCESS.tbl_Name.FieldName_access = " & rst!FieldName_sqlsvr & _
" SET ACCESS.tbl_Name.FieldName_access = " & rst!FieldName_sqlsvr)
rst.MoveNext
Loop
End If
conn.Close
rst.Close
Set dbObj = Nothing
End Sub
You should add a linked table (or a pass-through query) to get the data from SQL Server, create an Update Query in your MDB, using a JOIN to update all rows at once (your can use the query designer for this part) and then execute that query using CurrentDb.Execute.