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,
Related
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
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`
I am trying to run an append query to update a table based on the first 30 records for parameters in an sql statement. All of the data resides in an Access 2010 database, and I would like to run the query based off of a button on a form.
I am new to vba and assembled the following code based off of posts.
Option Compare Database
Private Sub Command3_Click()
Dim sql As String
Dim i As Integer
Dim j As Integer
Dim rst As DAO.Recordset
Dim dbs As DAO.Database
Dim strTerritory As String
Set dbs = CurrentDb
strTerritory = "Alex Hernandez"
strSQL = "INSERT INTO tblWeather30DayMovingFinal ( NEW, RptdDate, [Clm Nbr], WeatherLimit ) SELECT TOP 30 tblWeather30DayMoving.[NEW], tblWeather30DayMoving.[RptdDate], tblWeather30DayMoving.[Clm Nbr], 1 AS WeatherLimit FROM tblWeather30DayMoving WHERE (((tblWeather30DayMoving.NEW)= strTerritory ) AND ((tblWeather30DayMoving.RptdDate) Between #" & i & "/1/" & j & "# And #" & i & "/28/" & j & "#)); "
Set rst = dbs.OpenRecordset("tblWeather30DayMoving", dbOpenTable)
With rst
For j = 2003 To 2013
For i = 1 To 12
If Not (rst.EOF And rst.BOF) Then
.MoveFirst
Do
CurrentDb.Execute strSQL
.MoveNext
Loop Until .EOF
End If
Next i
Next j
End With
Set rst = Nothing
End Sub
I receive the following error message. I am trying to figure out how to get the loop to fill my date references in the sql.
Run-time error '3075':
Syntax error in date in query expression '(((tblWeather30DayMoving.NEW)- strTerritory ) AND ((tblWeather30DayMoving.RptdDate) Between #0/1/0# And #0/28/0#)'.
Any idea how to pass i and j to the sql statement instead of the 0's that are currently showing?
You are setting the strSQL string outside of your loop.
At this point, the values of i and j are 0.
You need to assign value to strSQL inside of the second loop:
For j = 2003 To 2013
For i = 1 To 12
strSQL = "INSERT INTO tblWeather30DayMovingFinal ( NEW, RptdDate, [Clm Nbr], WeatherLimit ) SELECT TOP 30 tblWeather30DayMoving.[NEW], tblWeather30DayMoving.[RptdDate], tblWeather30DayMoving.[Clm Nbr], 1 AS WeatherLimit FROM tblWeather30DayMoving WHERE (((tblWeather30DayMoving.NEW)= strTerritory ) AND ((tblWeather30DayMoving.RptdDate) Between #" & i & "/1/" & j & "# And #" & i & "/28/" & j & "#)); "
If Not (rst.EOF And rst.BOF) Then
.MoveFirst
Do
CurrentDb.Execute strSQL
.MoveNext
Loop Until .EOF
End If
Next i
Next j
I did it in notepad and not tested, but here is the idea:
Option Compare Database
option explicit
Private Sub Command3_Click()
Dim sql As String, sql2 as string
Dim i As Integer
Dim j As Integer
Dim rst As DAO.Recordset
Dim dbs As DAO.Database
Dim strTerritory As String
Set dbs = CurrentDb
strTerritory = "Alex Hernandez"
sql = "INSERT INTO tblWeather30DayMovingFinal ( NEW, RptdDate, [Clm Nbr], WeatherLimit ) " & _
"SELECT TOP 30 tblWeather30DayMoving.[NEW], tblWeather30DayMoving.[RptdDate], tblWeather30DayMoving.[Clm Nbr], 1 AS WeatherLimit " & _
"FROM tblWeather30DayMoving WHERE (((tblWeather30DayMoving.NEW)= strTerritory ) AND ((tblWeather30DayMoving.RptdDate) Between #mm/01/yyyy# And #mm/28/yyyy#)); "
Set rst = dbs.OpenRecordset("tblWeather30DayMoving", dbOpenTable)
With rst
For j = 2003 To 2013
For i = 1 To 12
If Not (rst.EOF And rst.BOF) Then
.MoveFirst
Do
sql2 = replace(1, sql,"yyyy", cstr(j)) 'replace "jjjj" by year
sql2 = replace(1,sql2,"mm", format(i,"00")) 'replace "mm" by month
debug.print sql2
CurrentDb.Execute sql2 'this can be REM'd once it is all working
.MoveNext
Loop Until .EOF
End If
Next i
Next j
End With
Set rst = Nothing
End Sub
Also note that you did not set Option Explicit, and you are mixing variable names between strSql and Sql.
I created the sql string using silly dates, and then replaced them by the appropriate figues in the loop, just before execution. Not the most efficient, but I find it easy and readable.