Adding a New Field to a Table using VBA 2

[HMJ]

How can you - via VBA - add a field to a newly created table?

I am attempting to automate a function where the following steps are taken:
1 - create an employee roster (table) using a query
2 - add a field to the table called trained.

There are more queries and reports to run after this, but it is straight forward and I can do a VBA to get that done. What I can't seem to figure out is how to automate adding the new field to the newly created table.

Samples are welcome.

Thanks

Harry J.
HMJessen@Yahoo.com

 

[Rolliee]

This is how the ACCESS help file shows how to make a table:

Sub CreateFieldX()

Dim dbsNorthwind As Database
Dim tdfNew As TableDef
Dim fldLoop As Field
Dim prpLoop As Property

Set dbsNorthwind = OpenDatabase("Northwind.mdb&quot

Set tdfNew = dbsNorthwind.CreateTableDef("NewTableDef&quot

' Create and append new Field objects for the new
' TableDef object.
With tdfNew
' The CreateField method will set a default Size
' for a new Field object if one is not specified.
.Fields.Append .CreateField("TextField", dbText)
.Fields.Append .CreateField("IntegerField", dbInteger)
.Fields.Append .CreateField("DateField", dbDate)
End With

dbsNorthwind.TableDefs.Append tdfNew

Debug.Print "Properties of new Fields in " & tdfNew.Name

' Enumerate Fields collection to show the properties of
' the new Field objects.
For Each fldLoop In tdfNew.Fields
Debug.Print " " & fldLoop.Name

For Each prpLoop In fldLoop.Properties
' Properties that are invalid in the context of
' TableDefs will trigger an error if an attempt
' is made to read their values.
On Error Resume Next
Debug.Print " " & prpLoop.Name & " - " & _
IIf(prpLoop = "", "[empty]", prpLoop)
On Error GoTo 0
Next prpLoop

Next fldLoop

' Delete new TableDef because this is a demonstration.
dbsNorthwind.TableDefs.Delete tdfNew.Name
dbsNorthwind.Close

End Sub
You can do an opentable and create from her. I have not done it but it looks doable. I have made forms and conntrols similarly.

Rollie E

 

[Rolliee]

This is how the ACCESS help file shows how to make a table:

Sub CreateFieldX()

Dim dbsNorthwind As Database
Dim tdfNew As TableDef
Dim fldLoop As Field
Dim prpLoop As Property

Set dbsNorthwind = OpenDatabase("Northwind.mdb&quot

Set tdfNew = dbsNorthwind.CreateTableDef("NewTableDef&quot

' Create and append new Field objects for the new
' TableDef object.
With tdfNew
' The CreateField method will set a default Size
' for a new Field object if one is not specified.
.Fields.Append .CreateField("TextField", dbText)
.Fields.Append .CreateField("IntegerField", dbInteger)
.Fields.Append .CreateField("DateField", dbDate)
End With

dbsNorthwind.TableDefs.Append tdfNew

Debug.Print "Properties of new Fields in " & tdfNew.Name

' Enumerate Fields collection to show the properties of
' the new Field objects.
For Each fldLoop In tdfNew.Fields
Debug.Print " " & fldLoop.Name

For Each prpLoop In fldLoop.Properties
' Properties that are invalid in the context of
' TableDefs will trigger an error if an attempt
' is made to read their values.
On Error Resume Next
Debug.Print " " & prpLoop.Name & " - " & _
IIf(prpLoop = "", "[empty]", prpLoop)
On Error GoTo 0
Next prpLoop

Next fldLoop

' Delete new TableDef because this is a demonstration.
dbsNorthwind.TableDefs.Delete tdfNew.Name
dbsNorthwind.Close

End Sub
You can do an opentable and create from her. I have not done it but it looks doable. I have made forms and controls similarly.

If you are using 2000, your have to add a DAO and reference ms DAO 3.6 to get the job done. Need more help? ask!

rollie@bwsys.net

 

[HMJ]

Tried your code, Rolliee, but couldn't get it to work. I ended up playing with it and got this far:

Dim stDocName As String
Dim stTblName As String
Dim new_fld As Fields

stTblName = "Company_Roster"
DoCmd.OpenTable stTblName
Set new_fld = stTblName.CreateField("Quarter", dbText, 6)
Company_Roster.Fields.Append new_fld
DoCmd.Close acTable, stTblName

I get an error that says "stTblName is an invalid qualifier" on the line "Set new_fld = stTblName.CreateField("Quarter", dbText, 6)"

So I change that to "Set new_fld = Company_Roster.CreateField("Quarter", dbText, 6)". That produces an error message of "Object Required".

I am at a loss here. All I want to do is open the table, and add the new field called "Quarter".

 

[Rolliee]

HMJ,

Did you add the DAO to the database/ recordset/ table objects? and did you set the references 'library' to Microsoft DAO 3.6?

Rollie

 

[Rolliee]

HJ,

The following code just added a three field table to my current mdb with the name of "Table2" and the fields below.

start code;;;;;;;
Dim dbs As DAO.Database
Dim tdfNew As DAO.TableDef
Dim fldLoop As DAO.Field
Dim prpLoop As DAO.Property

Set dbs = CurrentDb()

Set tdfNew = dbs.CreateTableDef("Table2&quot

' Create and append new Field objects for the new
' TableDef object.
With tdfNew
' The CreateField method will set a default Size
' for a new Field object if one is not specified.
.Fields.Append .CreateField("TextField", dbText)
.Fields.Append .CreateField("IntegerField", dbInteger)
.Fields.Append .CreateField("DateField", dbDate)
End With

dbs.TableDefs.Append tdfNew

end code;;;;;

The reference in design mode, Tools, References down the list to MS DOA 3.6 had to be clicked.


rollie@bwsys.net

 

[p27br]

here's a method using ADO :
you need to set the reference to Microsoft ADO Ext 2.6 for DDL and Security and Microsoft Active X Data Objects 2.1 Library

Function AddFieldToTable(strTable As String)
Dim cat As New ADOX.Catalog
Dim tbl As New ADOX.Table
Dim cnn As New ADODB.Connection

Set cnn = CurrentProject.Connection
Set cat.ActiveConnection = cnn
Set tbl = cat.Tables(strTable)

tbl.Columns.Append "fieldname"
cnn.Close
Set tbl = Nothing
Set cat = Nothing
Set cnn = Nothing
End Function

 

[HMJ]

OKAY, Let's try it again.

I think it is me, and I am missing something.

What I need to do is ADD a column to a table that already exists. The above code creates the table and adds the column(s).

How can I just add one column to an existing table?

Thanks.


Harry Jessen
HMJessen@Yahoo.com

 

[JohnLowell]

Here is what I use:

Dim dbs As Database, tdf As TableDef
Dim fld As Field
Dim intFlag As Integer

Set dbs = currentdb
' return reference to table
Set tdf = dbs.TableDefs!YourTableNameHere

intFlag = 0

For Each fld In tdf.Fields
If fld.Name = "MissingFieldNameHere" Then
intFlag = 1
End If
Next fld

If intFlag = 0 Then
' Create new Field object.
Set fld = tdf.CreateField("MissingFieldNameHere&quot
' Set Type and Size properties of Field object.
fld.Type = dbInteger

' Append field.
tdf.Fields.Append fld

End If