How to add YES/NO checkbox column to existing table using VBA? - vba

To begin with, I'm quite new to access.
I have a table , call it 'A'. I also have a form with a button which triggers an event when pushed. Using VBA I want to add a YES/NO column to 'A'.
I have accomplished that with the following code:
Dim strSQL As String
strSQL = "ALTER TABLE 'A' ADD COLUMN test YESNO;"
CurrentDb.Execute strSQL
But it's just zeros on each row. I want to have the checkbox style. I know how to set it manually in "Display Control" but since I'm creating a "program" for a friend I want it to be set automatically when the button is pushed.
I have tried working around this problem for a while now and to be honest I don't even remember all the results I have gotten, all I know is that it's not what I want.
On different forums, with posts as old as 2003, I find some people recommending changing the "fld.CreateProperty..." to "fld.Append..." and vice versa. Not working for me.
The code following below is what I have tried but I get:
"Run-time error '3421' Data type conversion error."
Set db = CurrentDb
Set td = db.TableDefs("A")
Set fld = td.Fields("test")
Set prp = fld.CreateProperty("DisplayControl", dbInteger, 106)
fld.Properties.Append prp
After some help in the comments my VBA code looks like this:
Private Sub Command13_Click()
Dim strSQL As String
Dim dbs As DAO.Database
Dim tdf As DAO.TableDef
Dim fld As DAO.Field
Dim prp As DAO.Property
Set dbs = CurrentDb
strSQL = "ALTER TABLE table ADD COLUMN test YESNO;"
dbs.Execute strSQL
Set tdf = dbs.TableDefs("table")
Set fld = tdf.Fields("test")
Set prp = fld.CreateProperty("DisplayControl", dbInteger, 106)
fld.Properties.Append prp`
End Sub
When this code runs from a press of a button, I get the error
"Compile error: User-defined type not defined".
The debugger highlights the following yellow:
Private Sub Command13_Click()
and the following blue:
Dim dbs As DAO.Database

Your SQL syntax is not correct. Once corrected, this runs smoothly and as intended here:
Public Function SetFieldDisplay()
Dim strSQL As String
Dim dbs As DAO.Database
Dim tdf As DAO.TableDef
Dim fld As DAO.Field
Dim prp As DAO.Property
Set dbs = CurrentDb
strSQL = "ALTER TABLE TestTable ADD COLUMN DisplayTest YESNO;"
dbs.Execute strSQL
Set tdf = dbs.TableDefs("TestTable")
Set fld = tdf.Fields("DisplayTest")
Set prp = fld.CreateProperty("DisplayControl", dbInteger, 106)
fld.Properties.Append prp
End Function

Related

How do I loop through a MS Access database and lock all the tables

I use the following code to lock some data tables in my database:
Application.SetHiddenAttribute acTable, "Employees", True
And I use this code to loop through a form to clear all the text boxes in a userform:
Dim ctl_text As Control
For Each ctl_text In Me.Controls
If ctl_text.ControlType = acTextBox Then ctl_text = Null
Next
Set ctl_text = Nothing
I was hoping to combine the above logic to be able to loop through the database and lock all the tables.
I was trying the following:
Dim tdf As Dao.TableDef
Dim db As Dao.Database
Set db = CurrentDb
For Each tdf In db.TableDefs
If (VBA.Left(tdf.Name, 6) = "prefix") Then
Set Application.SetHiddenAttribute = True
End If
Next tdf
I am however getting an error telling me that the "SetHiddenAttribute" argument is not optional.
Any idea how I can go about this?
I guess you have this in mind:
Dim tdf As DAO.TableDef
Dim db As DAO.Database
Set db = CurrentDb
For Each tdf In db.TableDefs
If VBA.Left(tdf.Name, 6) = "prefix" Then
tdf.Attributes = tdf.Attributes Or dbHiddenObject
End If
Next
Please note, that this not "locks" the tables, only hide them from the normal views.
To remove the hidden attribute:
tdf.Attributes = tdf.Attributes And Not dbHiddenObject

How to read from Access databases into visualbasic

I would like to be able to see a line of text in a textbox from an access database.
I know how to write and delete data from the database through visual basic code, but how can you read data?
If for example, I have something that says "Hi" saved in my database. How can I use a line of code in visual basic to read "Hi" and then show it in a textbox or simply in the console app?
Sub SayHi()
Dim dbs As DAO.Database
Dim rst As DAO.Recordset
Dim strCity As String
Set dbs = CurrentDb
Set rst = dbs.OpenRecordset("SELECT Foo FROM tblCustomers WHERE Foo = " & "'Hi'")
'Begin row processing
Do While Not rst.EOF
MsgBox rst!Foo
Loop
'Cleanup
rst.Close
Set rst = Nothing
End Sub

Error executing a saved Access query that depends on parameter values from a form

I'm trying to simply open a query and SELECT everything from it. The query requires FROM and TO dates. I have a frmA through which I pass the parameters to the query. I open the frmA and put in 2 dates. Funny thing is, when I do docmd.openQuery "qryInsurance" it opens it wihout a problem, however, when I try to Select * from qryInsurance, it tells me that it's expecting 2 parameters.
here is the code:
Public Function CountFollowup() As Boolean
On Error GoTo error_handler:
Dim rs1 As DAO.Recordset
Dim rs2 As DAO.Recordset
Dim strsql As String
Dim rcount As Integer
Set DB = CurrentDb
CountFollowup = False
DoCmd.OpenQuery "qryInsurance"
strsql = "SELECT * FROM [qryInsurance];"
'CurrentDb.Execute "Delete * FROM temp_InsData"
Set rs1 = CurrentDb.OpenRecordset(strsql, , dbOpenSnapshot) ' here is where it gives me an ERROR, expecting 2 parameters when it OPENS it fine before strsql
Set rs2 = CurrentDb.OpenRecordset("temp_InsData")
Debug.Print strsql
Exit Function
error_handler:
MsgBox Err.Number & " - " & Err.Description
End Function
It seems qryInsurance includes references to form controls, maybe like this ... Forms!frmA!From
Those references are resolved when you use DoCmd.OpenQuery, but not when you use the DAO.Database.OpenRecordset method. With OpenRecordset, they are interpreted as parameters for which you have not supplied values.
If you open the query's QueryDef and then feed each parameter Name to Eval(), it will give you the values of those form controls ... so you can then supply them as the values for the parameters.
That description may not be easy to follow, but the code is pretty easy.
Add these variable declarations before Set db = CurrentDb ...
Dim db As DAO.Database
Dim prm As DAO.Parameter
Dim qdf As DAO.QueryDef
Dim CountFollowup ' As what? Boolean?
Then later ...
Set db = CurrentDb
CountFollowup = False
'DoCmd.OpenQuery "qryInsurance"
'strsql = "SELECT * FROM [qryInsurance];"
'CurrentDb.Execute "Delete * FROM temp_InsData"
Set qdf = db.QueryDefs("qryInsurance")
For Each prm In qdf.Parameters
prm.Value = Eval(prm.Name)
Next
'Set rs1 = CurrentDb.OpenRecordset(strsql, , dbOpenSnapshot) ' here is where it gives me an ERROR, expecting 2 parameters when it OPENS it fine before strsql
Set rs1 = qdf.OpenRecordset(dbOpenSnapshot)
' and the rest ...

Errors with linked tables and Ms Access ( Run-time error '3622' : dbSeeChanges/Identity column )

I am trying to output the name of all linked tables, including their fields which are Date/Time, and that fields values.
The following code can output the first table, field name and their first value, not all values, although when it gets to the next linked table, I get this error
Run-time Error '3622'
You must use the dbSeeChanges option with OpenRecordSet when accessing a SQL Server table that has an IDENTITY column.
Here is my code
Private Sub btnGetFields_Click()
Dim db As DAO.Database
Dim tdf As DAO.TableDef
Dim f As Field
Dim rst As DAO.Recordset
Dim numField As Integer
Set db = CurrentDb
For Each tdf In db.TableDefs
If Left$(tdf.Connect, 9) = "ODBC;DSN=" Then
Set rst = CurrentDb.OpenRecordset(tdf.Name)
numField = rst.Fields.Count
Debug.Print "Table: " & tdf.Name
For index = 0 To numField - 1
If rst.Fields(index).Type = dbDate Then
Debug.Print "Field: " & rst.Fields(index).Name; " Value : "; rst.Fields(index).Value
End If
Next
End If
Next
Set tdf = Nothing
Set db = Nothing
End Sub
I read something that if I'm using sql tables I should use ADO?
Any ideas?
You can continue to use your existing DAO code, just change
Set rst = CurrentDb.OpenRecordset(tdf.Name)
to
Set rst = CurrentDb.OpenRecordset(tdf.Name, dbOpenSnapshot)
That opens a static read-only Recordset, so dbSeeChanges is not required.

Invalid Operation Setting Result Set Object VBA

Hi Maybe someone can enlighten me here. Using VBA code and I want to include a check for zero record count from a query and it now fails at the code I added where it was fine before. Code below shows set up:
Sub MySub()
Dim db As DAO.Database
Set db = CurrentDb()
Dim qdf As DAO.QueryDef
Dim sqlQry As String
Dim rst As DAO.Recordset
sqlQry = "My Query String"
If DLookup("Name", "MSysObjects", "Name= 'QueryName1'") <> "" Then
Set qdf = CurrentDb.QueryDefs("QueryName1")
qdf.SQL = sqlQry
Else
Set qdf = CurrentDb.CreateQueryDef("QueryName1", sqlQry)
End If
Set rst = db.OpenRecordset(qdf.Name) << FAILS HERE
If rst.RecordCount <> 0 Then
DoCmd.OpenQuery (qdf.Name)
Else
MsgBox "no data returned"
Exit Sub
End If
Set qdf = Nothing
Set db = Nothing
End Sub
It fails on the line shown above with run "time error 3219 Invalid Operation". the only thing I changed is added an object reference for business objects for another part of the code, not this part. It ran fine before and only other change is start of a new sub below this code but running only this bit code (not the whole module) in debug mode it came up with the error.