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`
Related
I have table named schedules where I should change values of some field depending value of another field
I manage to do that running code on form (record by record) but now I like to run it outside of form
because of mass import to database - Is it possible?
Here is part of my code:
If Not IsNumeric(DAY_0_DEST_0_NAME) Then
DAY_0_TYPE_0_OSP = 1
Else: DAY_0_TYPE_0_OSP = 3
End If
If Nz(DAY_0_DEST_0_NAME) = "" Then
DAY_0_TYPE_0_OSP = 0
End If
If Not IsNumeric(DAY_0_DEST_1_NAME) Then
DAY_0_TYPE_1_OSP = 1
Else: DAY_0_TYPE_1_OSP = 3
End If
If Nz(DAY_0_DEST_1_NAME) = "" Then
DAY_0_TYPE_1_OSP = 0
End If
Possibly the easiest way to do this is to run some update SQL statements from a VBA procedure. And because you are altering two pairs of fields, you can do this in a small loop:
Sub sUpdateData()
Dim db As DAO.Database
Dim strSQL As String
Dim lngLoop1 As Long
Set db = DBEngine(0)(0)
For lngLoop1 = 0 To 1
db.Execute "UPDATE Table1 SET DAY_0_TYPE_" & lngLoop1 & "_OSP=3 WHERE IsNumeric(DAY_0_DEST_" & lngLoop1 & "_NAME)=True;"
db.Execute "UPDATE Table1 SET DAY_0_TYPE_" & lngLoop1 & "_OSP=1 WHERE IsNumeric(DAY_0_DEST_" & lngLoop1 & "_NAME)=False;"
db.Execute "UPDATE Table1 SET DAY_0_TYPE_" & lngLoop1 & "_OSP=0 WHERE DAY_0_DEST_" & lngLoop1 & "_NAME IS NULL;"
Next lngLoop1
Set db = Nothing
End Sub
Regards,
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.
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
I have a section of code which creates a new table and then attempts to copy the record set values into the table. The only problem is this it is quite slow and access shows the loading symbol whilst it is executing this insert section below. Currently this problem is occurring inserting 500 records, but I will need to insert around 10,000 to 20,000 when I get a final data set.
I = 1
DoCmd.SetWarnings False
RecordSet1.MoveFirst
Do While Not RecordSet1.EOF = True
SQL = "INSERT INTO " & FullName & " ("
For Each field In RecordSet1.fields()
SQL = SQL & " " & Replace(field.Name, ".", "_") & ","
Next field
SQL = SQL & "ValidationCheck)"
SQL = SQL & " VALUES("
For Each field2 In RecordSet1.fields()
SQL = SQL & "'" & field2.Value & "',"
Next field2
SQL = SQL & Matches(I) & ")"
DoCmd.RunSQL (SQL)
RecordSet1.MoveNext
I = I + 1
Loop
What I want to know is, is there any way I can speed this up? Or are there better approaches?
(What I am trying to do is create a table at run time with a unique set of fields from a RecordSet and add an extra column with a Boolean value stored in Match array for each Record). The creation works fine, but the insertion code above is very slow.
Yes, use DAO. So much faster. This example copies to the same table, but you can easily modify it so copy between two tables:
Public Sub CopyRecords()
Dim rstSource As DAO.Recordset
Dim rstInsert As DAO.Recordset
Dim fld As DAO.Field
Dim strSQL As String
Dim lngLoop As Long
Dim lngCount As Long
strSQL = "SELECT * FROM tblStatus WHERE Location = '" & _
"DEFx" & "' Order by Total"
Set rstInsert = CurrentDb.OpenRecordset(strSQL)
Set rstSource = rstInsert.Clone
With rstSource
lngCount = .RecordCount
For lngLoop = 1 To lngCount
With rstInsert
.AddNew
For Each fld In rstSource.Fields
With fld
If .Attributes And dbAutoIncrField Then
' Skip Autonumber or GUID field.
ElseIf .Name = "Total" Then
' Insert default value.
rstInsert.Fields(.Name).Value = 0
ElseIf .Name = "PROCESSED_IND" Then
rstInsert.Fields(.Name).Value = vbNullString
Else
' Copy field content.
rstInsert.Fields(.Name).Value = .Value
End If
End With
Next
.Update
End With
.MoveNext
Next
rstInsert.Close
.Close
End With
Set rstInsert = Nothing
Set rstSource = Nothing
End Sub
For multiple inserts in a loop, don't use SQL INSERT statements. Instead use a DAO.Recordset with .AddNew.
See this answer: https://stackoverflow.com/a/33025620/3820271
As positive side effects, your code will become better readable and you don't have to deal with the multiple formats for different data types.
For Each field In RecordSet1.Fields
rsTarget(field.Name) = field.Value
Next field
I am trying to add n columns to a table, like in this example of code where n = 10:
Sub toto()
Dim db As Database, i As Integer
Set db = CurrentDb()
For i = 1 To i = 10
db.Execute " ALTER TABLE time_series " _
& "ADD COLUMN F_" & i & " Number;"
' End If
Next i
End sub
I tried to convert i in string with CStr(i) but to no avail. Any hint?
EDIT: No column is added.
I have tested your code, I do not see any issues except for the fact, your For statement is a bit off and that you needed to set the db object. Try this code.
Sub toto()
Dim db As Database, i As Integer
Set db = CurrentDb
For i = 1 To 10
db.Execute " ALTER TABLE time_series " _
& "ADD COLUMN F_" & i & " Number;"
Next i
Set db = Nothing
End Sub