add a column to a table using visual basic

[Guest]

I am looking to have a user click a button on a form which then adds an
autonumbering field with name ID and type "AutoNumber." I know how to add a
row (that is, a new record) to table using visual basic, but I would
appreciate any knowlege about how to add an entirely new column and have that
column autonumber for each existing record. Thank you.

 

[strive4peace]

'~~~~~~~~~~~~~~~~

Sub testaddFieldToTable()
AddFieldToTable "test", "AutoID", dbLong, , "*AN*"
AddFieldToTable "test", "SomeID", dbLong, , "*Null*"
AddFieldToTable "test", "ImportLog", dbText, 255
AddFieldToTable "test", "DateCreated", dbDate, , "*Now*"

End Sub

'~~~~~~~~~~~~~~~~

Sub AddDateUserToTables()
Dim tdf As dao.TableDef, i As Integer
i = 1
For Each tdf In CurrentDb.TableDefs
If Left(tdf.Name, 4) <> "MSys" Then

AddFieldToTable tdf.Name, _
"UserIDc", dbLong, , "*Null*"

AddFieldToTable tdf.Name, _
"UserIDm", dbLong, , "*Null*"

AddFieldToTable tdf.Name, _
"DateCreated", dbDate, , "*Now*"

AddFieldToTable tdf.Name, _
"DateModified", dbDate

i = i + 1
End If
Next tdf
DoEvents
Set tdf = Nothing
MsgBox "Added fields to " & i & " tables", , "Done"
End Sub

'~~~~~~~~~~~~~~~~

Function AddFieldToTable( _
pTablename As String, _
pFldname As String, _
pDataType As Integer, _
Optional pFieldSize As Integer, _
Optional pOptions As String) _
As Boolean

'written by Crystal
'strive4peace2007 at yahoo.com

'PARAMETERS
'pTablename --> name of table to modify structure of
'pFldname --> name of field to create
'pDataType --> dbText, dbLong, dbDate, etc
'pFieldSize --> length for text fields
'pOptions --> *AN* = autonumber
' --> *Null* --> DefaultValue = Null
' --> *Now* --> DefaultValue = Now()

'NEEDS Reference to
'a Microsoft DAO Library

On Error GoTo AddFieldToTable_error

Dim db As Database, Fld As Field

'you could make this a passed parameter
' and open another database

Set db = CurrentDb

With db.TableDefs(pTablename)

Select Case pDataType
Case dbText
'Text
Set Fld = .CreateField(pFldname, _
pDataType, pFieldSize)

Case Else
'Long Integer, Date, etc
Set Fld = .CreateField(pFldname, pDataType)

End Select

If InStr(pOptions, "*AN*") > 0 Then
'Autonumber
Fld.Attributes = dbAutoIncrField
End If

If InStr(pOptions, "*Null*") > 0 Then
'Null for DefaultValue
Fld.DefaultValue = "Null"
End If

If InStr(pOptions, "*Now*") > 0 Then
'Now for DefaultValue
Fld.DefaultValue = "=Now()"
End If

.Fields.Append Fld
End With

db.TableDefs.Refresh
DoEvents

' MsgBox "Added --> " & pFldname _
& " to --> " & pTablename, , "Done"

AddFieldToTable_exit:
On Error Resume Next
Set Fld = Nothing
Set db = Nothing

Exit Function

AddFieldToTable_error:
'if the field is already there, ignore error
If Err = 3191 Then Resume Next

MsgBox Err.Description, , _
"ERROR " & Err.Number & " AddFieldToTable"

'press F8 to step through code and fix problem
Stop
Resume
Resume AddFieldToTable_exit

End Function
'~~~~~~~~~~~~~~~~

Warm Regards,
Crystal
Microsoft Access MVP 2006

*
Have an awesome day

remote programming and training
strive4peace2006 at yahoo.com

*