Adding field to an existing table

[Guest]

We have a number of cost centers. There is an Access database for each cost
center. We are changing our process and want to add either 1 or 2 new fields
to a table in each database.

Can this be done with VBA or do I have to manually insert the new fields in
each database. If it can be done programmatically, any help getting started
would be appreciated. Thanks for the help.

 

[Alex Dybenko]

Hi,
see CreateField in help:

Dim DB as database
Dim tbldef as tabledef
dim fld as Field

set db = OpenDatase("myDB.mdb")
set tblDef as db.tabledef("TableName")

With tblDef
set fld = .CreateField("New_Field",dbDouble)
.fields.append fld
End With

etc

--
Best regards,
___________
Alex Dybenko (MVP)
http://accessblog.net
http://www.PointLtd.com

 

[Guest]

Here is some code that contains what you are wanting to do.

'---------------------------------------------------------------------------------------
' Procedure : ApplyUpdates
' DateTime : 8/9/2007 16:29
' Author : Dave Hargis
' Purpose : Applies the selected updates to the selected mdb files
' : Enter the code for each update session in this module
'---------------------------------------------------------------------------------------
'
Private Function ApplyUpdates(strFileName As String) As Boolean
Dim dbx As Database
Dim strDir As String
Dim fs As Object

On Error GoTo ApplyUpdates_Error

strDir = Left(strFileName, InStrRev(strFileName, "\")) & "SchemaBk\"
If Dir(strDir, vbDirectory) = vbNullString Then
MkDir (strDir)
End If
Set fs = CreateObject("scripting.filesystemobject")
fs.copyfile strFileName, strDir
Set fs = Nothing

On Error Resume Next

Do While True
Err.Clear
Set dbx = OpenDatabase(strFileName, False, False, "MS Access;pwd=" &
Me.txtPwd)
If Err = 3031 Then
DoCmd.OpenForm "frmPassWord", acNormal, , , , acDialog,
strFileName
If Me.txtPwd = "Cancel" Then
MsgBox "Updates Canceled"
ApplyUpdates = False
Exit Function
End If
Else
Exit Do
End If
Loop

On Error GoTo ApplyUpdates_Error

With dbx
'Create Implementation Status Table
.Execute ("create table tblImplStatus(IMPLEMENT_ID COUNTER " & _
"CONSTRAINT IMPLEMENT_ID PRIMARY KEY, IMPLEMENT_STATUS
TEXT(50)," & _
"IMPLEMENT_TYPE TEXT(1));"), dbFailOnError

'Add columns to Contract
.Execute ("alter table contract ADD COLUMN ImplSTATUS_ID " & _
"LONG NOT NULL CONSTRAINT ImplStatus_ID REFERENCES " & _
"tblImplStatus(IMPLEMENT_ID);"), dbFailOnError

.Execute ("alter table contract ADD COLUMN ImplDate DATE;"),
dbFailOnError

.Execute ("alter table contract ADD COLUMN ImplCANCEL_Date DATE;"),
dbFailOnError

.Execute ("alter table contract ADD COLUMN ImplNotes MEMO;"),
dbFailOnError

.Execute ("alter table contract ADD COLUMN CANCEL_CODE Long;"),
dbFailOnError

'Add column to Employee table
.Execute ("ALTER TABLE Employee ADD COLUMN RRCDIMPLSTAT Bit;"),
dbFailOnError
End With

ApplyUpdates = True

ApplyUpdates_Exit:
On Error GoTo 0

dbx.Close

Exit Function

ApplyUpdates_Error:

MsgBox "Error " & Err.Number & " (" & Err.Description & _
") in procedure ApplyUpdates of VBA Document Form_frmUpDateTables"
ApplyUpdates = False
GoTo ApplyUpdates_Exit
End Function