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
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,
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 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 tried to translate a code from VBA excel to access. My data is a column of prices and I want to compute the returns.
This is the original VBA code in excel:
DerCol = Cells(T.Row, Columns.Count).End(xlToLeft).Column
Cells(T.Row, DerCol + 1) = "Returns"
For i = T.Row + 2 To T.End(xlDown).Row
Cells(i, DerCol + 1) = Application.WorksheetFunction.Ln(Cells(i, T.Column)) - Application.WorksheetFunction.Ln(Cells(i - 1, T.Column))
Next i
To get an idea of the output that I have in excel, click here.
In Access, I created a new column next to the prices' column and I would like to fill in exactly like in excel:
Sub vardaily()
Dim db As Database, T As Object, DerCol As Integer, y As TableDef
Dim rs As DAO.Recordset, i As Integer, strsql As String
'idea = SELECT prices FROM dailypricing, then creates newtable "VAR", copy and prices, compute historical and parametric VAR '
'create a new table var_daily'
Set db = CurrentDb()
'insert the pricing date and the prices from dbo_daily'
db.Execute "CREATE TABLE VAR_daily" _
& "(PricingDate CHAR, Price Number);"
'where clause to select the same traded product only'
db.Execute " INSERT INTO VAR_daily " _
& "SELECT PricingDate, Price " _
& "FROM dbo_PricingDaily " _
& "WHERE IndexId = 1;"
db.Execute " ALTER TABLE VAR_daily " _
& "ADD COLUMN Returns Number;"
'sql request to store prices'
strsql = "SELECT First(Price) as FirstPrice, Last(Price) as EndPrice FROM VAR_daily;"
'dao.recordset of the store prices'
Set rs = db.OpenRecordset(strsql, dbOpenDynaset)
'loop to change the prices'
For i = 2 To i = rs.RecordCount
rs.Edit
rs!Price(i) = Log(rs!Price(i)) - Log(rs!Price(i - 1))
rs.Update
Next i
db.Execute "INSERT INTO VAR_daily " _
& "(Returns) VALUES " _
& "(" & rs![Price] & ");"
End Sub
I have the following table that you can see here
I can not manage with the loop. I have no item in my collection at the end.
I looked at other example of loops like here but I did not find how to make an iteration with the last result.
Sorry, I really am a beginner in Ms Access and SQL. I started this week so I apologize if my question is very basic.
EDIT: I added the images and I replaced Firsttransaction and Lasttransaction by "FirstPrice" and "EndPrice".
EDIT2: Thanks to my new privilege, I can share a sample for those who are interested.
I have updated your complete code to what it should be. Again, I don't have an Access database handy to test it but it compiles and should work:
Sub vardaily()
Dim db As Database
Dim rs As DAO.Recordset, i As Integer, strsql As String
Dim thisPrice, lastPrice
'idea = SELECT prices FROM dailypricing, then creates newtable "VAR", copy and prices, compute historical and parametric VAR '
'create a new table var_daily'
Set db = CurrentDb()
'insert the pricing date and the prices from dbo_daily'
db.Execute "CREATE TABLE VAR_daily" _
& "(PricingDate CHAR, Price Number);"
'where clause to select the same traded product only'
db.Execute " INSERT INTO VAR_daily " _
& "SELECT PricingDate, Price " _
& "FROM dbo_PricingDaily " _
& "WHERE IndexId = 1 " _
& "ORDER BY PricingDate;"
db.Execute " ALTER TABLE VAR_daily " _
& "ADD COLUMN Returns Number;"
'sql request to retrieve store prices'
strsql = "SELECT * FROM VAR_daily ORDER BY PricingDate;" ' just get all fields
'dao.recordset of the store prices'
Set rs = db.OpenRecordset(strsql, dbOpenDynaset)
'loop to change the prices'
lastPrice = rs.Fields("Price") ' get price from first record and remember
rs.MoveNext ' advance to second record and start loop
While (Not rs.EOF())
thisPrice = rs.Fields("Price")
rs.Edit
rs!Returns = Log(thisPrice) - Log(lastPrice)
rs.Update
lastPrice = thisPrice ' remember previous value
rs.MoveNext ' advance to next record
Wend
End Sub
I need to add a calculated field to an existing table. I am aware of two ways to do this and I'm wondering if anyone has any input on which is best and how to make them work:
Using TableDef.CreateField, then TableDef.Fields.Append
Using a DDL Alter Table ADD COLUMN statement
I tried using the first method, but I keep getting a 3211 error because Access could not lock the table. I don't have the table open. However, I am calling CreateField from a form that has accessed which fields currently exist in the table.
Here's the code for calling CreateField:
`
Public Sub AddFieldToTable(strTable As String, strField As String, nFieldType As Integer)
Dim db As DAO.Database
Dim tdf As DAO.TableDef
Dim fld As DAO.Field
On Error GoTo ErrorHandler
Set db = CurrentDb
Set tdf = db.TableDefs(strTable)
Set fld = tdf.CreateField(strField, nFieldType)
tdf.Fields.Append fld
MsgBox "The field named [" & strField & "] has been added to table [" & strTable & "]."
Set tdf = Nothing
Set db = Nothing
Exit Sub
ErrorHandler:
MsgBox "An error has occurred. Number: " & Err.Number & ", description: " & Err.Description
Exit Sub
End Sub
`
I get the error on the tdf.fields.append line. Would executing an ALTER TABLE statement be better? What are the tradeoffs?
You can use DDL to create fields:
Long:
CurrentDb.Execute "ALTER TABLE t ADD COLUMN a Long not null", dbFailOnError
(tack on NOT NULL IDENTITY(1,1) for an autonumber)
CurrentDb.Execute "ALTER TABLE t ADD COLUMN b text(100)", dbFailOnError
Boolean:
CurrentDb.Execute "ALTER TABLE t ADD COLUMN c Bit not null", dbFailOnError
DateTime:
CurrentDb.Execute "ALTER TABLE t ADD COLUMN d datetime null", dbFailOnError
Memo:
CurrentDb.Execute "ALTER TABLE t ADD COLUMN e memo null", dbFailOnError
Obviously, this lends itself well to functionalization, and you could just pass in your own eternal enum, combined with a Select, to construct the string and execute it:
Public Sub AddFieldToTable(TableName as string, FieldName as string, _
FieldType as Long, FieldLen as Long, FieldAllowsNull as Boolean)
Dim FieldText as String
Select Case(FieldType)
Case 0:
FieldText = "Long"
Case 1:
FieldText = "text(" & FieldLen & ")"
Case 2:
FieldText = "bit"
Case 3:
FieldText = "datetime"
Case 4:
FieldText = "memo"
End Select
Dim Sql as string
Sql = "ALTER TABLE " & TableName & " ADD COLUMN " & FieldName & " " & FieldText
If FieldAllowsNull then
Sql = Sql & " NULL"
Else
Sql = Sql & " NOT NULL"
End If
CurrentDb.Execute Sql, dbFailOnError
End Sub
I got the code working with either the CreateField or the ALTER TABLE statement. The key here was that I had used a recordset to access the table's data (I needed to check whether the field already existed and/or contained data before I ran the AddField method). I moved the rst.close statement up to before I edited the table structure and it worked! No more 3211.
`
Set db = CurrentDb
Set rst = db.OpenRecordset(strTable)
bFieldExists = Field_Exists(rst, strOutputField) ' Custom field_exists in table function
If bFieldExists then nFieldType = rst(strOutputField).Type
If CheckFieldHasValues(strTable, strOutputField) = True Then ' custom CheckField function
If MsgBox("The output field has values in it. Proceed?", vbYesNo) = vbNo Then Exit Sub
End If
rst.Close ' Recordset must release the table data before we can alter the table!
If bFieldExists = False Then
AddFieldToTable strTable, strOutputField, dbCurrency
End If
Set db = Nothing
I just did the following in a module and it works fine
Sub AddTableFields()
Dim db As DAO.Database
Dim t As DAO.TableDef
Dim f As DAO.Field
Set db = CurrentDb
Set t = db.TableDefs("tl_LongTermStat")
Dim intY As Integer
Dim intQ As Integer
For intY = 2012 To 2018
For intQ = 1 To 4
Set f = t.CreateField("Y" & intY & "Q" & intQ, dbText, 10)
t.Fields.Append f
Next
Next
Debug.Print "AddTableFields() done"
End Sub