[AccessD] changing fieldname

Neal Kling nkling at co.montgomery.ny.us
Wed May 4 07:33:17 CDT 2005


>>can i change a fieldname of a table with a definition query and ALTER TABLE tablename ALTER COLUMN?

Pedro,

I would probably use ALTER TABLE to add a field, then copy the contents and DROP the old one. But some years ago I wrote functions to do this and used them in a project. I'm pasting them in for you incase you'd prefer this. There are functions to create an index, create and delete a table and field, create, modify and delete properties and create and delete table links.

Watch for line wraps.

Neal


'***********************************************************************************
'I chose to pass database objects rather than the name because I find
'myself using a number of these for a given update.  In this way I'm
'opening the target database once for the process rather than for every
'function that runs.

Option Compare Database
Option Explicit


'Comments  :  create an index in the specified db and table
'Parameters:  db - Database object
'             strTable - string, Table in which to create index
'             strIndexName - string, Index to create
'             strFields() - string, Array of fields on which to base index.
'               This must be an array even if there is only one element.
'             fUnique - boolean, True if you want a unique index
'             fPrimary - boolean, True if you want this to be the key index
'Returns   :  True on success
'Created by: Neal A. Kling
'Created   : 6/4/99 2:54:36 PM
Function CreateIndex(db As Database, strTable As String, strIndexName As String, _
      strFields() As String, fUnique As Boolean, fPrimary As Boolean) As Boolean
On Error GoTo Err_CreateIndex

Dim tbldef As TableDef
Dim indx As Index
Dim indxfld As Field
Dim I As Integer

Set tbldef = db.TableDefs(strTable)

On Error Resume Next 'ignore error if index doesn't exist
  tbldef.Indexes.Delete strIndexName
  Err.Clear
On Error GoTo Err_CreateIndex

Set indx = tbldef.CreateIndex(strIndexName)
  With indx
    .Unique = fUnique
    .Primary = fPrimary
    For I = 0 To UBound(strFields) - 1
      .Fields.Append .CreateField(strFields(I))
    Next I
  End With
  tbldef.Indexes.Append indx
  tbldef.Indexes.Refresh
  
  CreateIndex = True  'success

Exit_CreateIndex:
On Error Resume Next
Set tbldef = Nothing
Set indx = Nothing
Exit Function

Err_CreateIndex:
  Select Case Err
  Case 0    'insert Errors you wish to ignore here
    Resume Next
  Case Else 'All other errors will trap
    Beep
    MsgBox Err.Number & "; " & Err.Description, , "Error in function basObjectHandlers.CreateIndex"
  Resume Exit_CreateIndex
  End Select
  Resume 0  'FOR TROUBLESHOOTING
End Function

'Comments  :  Delete a table from the specified db
'Parameters:  db - Database object
'             strTable - string, Table which is to be deleted
'Returns   : True on success
'Created by: Neal A. Kling and John Sass
'Created   : 3/5/99 4:18:55 PM
Function DeleteTable(db As Database, strTable As String) As Boolean
On Error GoTo Err_DeleteTable

  db.TableDefs.Delete strTable
  DeleteTable = True      'Delete happened or Table does not exist

Exit_DeleteTable:
'Clean up
  On Error Resume Next
Exit Function

Err_DeleteTable:
  Select Case Err
  Case 3265      'Item doesn't exist in collection
    Resume Next
  Case Else   'All other errors will trap
    Beep
    MsgBox Err.Description, , "Error in function basObjectHandlers.DeleteField"
    DeleteTable = False
    Resume Exit_DeleteTable
  End Select
  Resume 0    'FOR TROUBLESHOOTING
End Function
'Comments  :  deletes a field in the specified db and table
'Parameters:  db - Database object
'             strTable - string, Table in which to delete field
'             strFieldName - string, Field to be deleted
'Returns   :  true on success
'Created by: Neal A. Kling
'Created   : 3/5/99 4:39:02 PM
Function DeleteField(db As Database, strTable As String, _
                    strFieldName As String) As Boolean
On Error GoTo Err_DeleteField
  
  Dim tbldef As TableDef
  Set tbldef = db.TableDefs(strTable)
  
  tbldef.Fields.Delete strFieldName
  DeleteField = True          'Delete happened or field did not exist

Exit_DeleteField:
'Clean up
  On Error Resume Next
  Set tbldef = Nothing
Exit Function

Err_DeleteField:
  Select Case Err
  Case 3265      'Item doesn't exist in colection
    Resume Next
  Case Else   'All other errors will trap
    Beep
    MsgBox Err.Description, , "Error in function basObjectHandlers.DeleteField"
    DeleteField = False
    Resume Exit_DeleteField
  End Select
  Resume 0    'FOR TROUBLESHOOTING
End Function

'Comments  :  delete an index in the specified db and table
'Parameters:  db - Database object
'             strTable - string, Table in which to delete index
'             strIndexName - string, Index to be deleted
'Returns   :  true on success
'Created by: Neal A. Kling
'Created   : 3/5/99 4:42:35 PM
Function DeleteIndex(db As Database, strTable As String, _
                    strIndexName As String) As Boolean
On Error GoTo Err_DeleteIndex

  Dim tbldef As TableDef
  Set tbldef = db.TableDefs(strTable)
       
  tbldef.Indexes.Delete strIndexName
  DeleteIndex = True      'Delete happened or field did not exist

Exit_DeleteIndex:
  On Error Resume Next
  Set tbldef = Nothing
Exit Function

Err_DeleteIndex:
  Select Case Err
  Case 3265      'Item doesn't exist in colection
    Resume Next
  Case Else 'All other errors will trap
    Beep
    MsgBox Err.Description, , "Error in function basObjectHandlers.DeleteIndex"
    DeleteIndex = False
  Resume Exit_DeleteIndex
  End Select
  Resume 0  'FOR TROUBLESHOOTING
End Function

'Comments  :  create a field in the specified db and table
'Parameters:  db - Database object
'             strTable - string, Table in which to create field
'             strFieldName - string, Field to be created
'             intType - integer, Field type
'             intLength - variant, optional, length; applies text fields
'             fAutoIncrement - boolean, optional, if type is dbLong you may set this to true
'               to create an autonumber field
'Returns   :  true on success
'Created by: Neal A. Kling
'Created   : 3/5/99 5:22:59 PM
Function CreateField(db As Database, strTable As String, strFieldName As String, intType As Integer, _
             Optional intLength As Variant, Optional fAutoIncrement As Boolean) As Boolean
On Error GoTo Err_CreateField

Dim tbldef As TableDef
Dim fld As Field

Set tbldef = db.TableDefs(strTable)

'create the field
Set fld = tbldef.CreateField(strFieldName, intType, intLength)
  If fAutoIncrement = True And intType = dbLong Then
    'make an autonumber field
    fld.Attributes = dbAutoIncrField
  End If
tbldef.Fields.Append fld
tbldef.Fields.Refresh

'return true if successful
CreateField = True

Exit_CreateField:
  On Error Resume Next
  'clean up
  Set fld = Nothing
  Set tbldef = Nothing
  Exit Function

Err_CreateField:
  Select Case Err
  Case 0    'insert Errors you wish to ignore here
    Resume Next
  Case 3191 'field already exists
    CreateField = True
    Resume Exit_CreateField
  Case Else 'All other errors will trap
    Beep
    MsgBox Err.Number & "; " & Err.Description, , "Error in function Backend Upgrades.CreateField"
  Resume Exit_CreateField
  End Select
  Resume 0  'FOR TROUBLESHOOTING
End Function

'Comments  :  set a field property
'Parameters:  db - Database object
'             strTable - string, Table in which to set property
'             strField - string, Field in which to set property
'             strProperty - string, Name of property
'             varValue - variant, Value to be set
'             intPropType - integer, Property type
'Returns   :  True on success
'Created by: Neal A. Kling
'Created   : 3/10/99 8:27:20 AM
Function SetFieldProperty(db As Database, strTable As String, strField As String, strProperty As String, _
    varValue As Variant, intPropType As Integer) As Boolean
  
  On Error GoTo Err_SetFieldProperty
  Dim tbldef As TableDef
  Dim fld As Field
  Dim prop As Property
  Dim MyProp As Property
  
  Set tbldef = db.TableDefs(strTable)
  
  tbldef.Fields.Refresh
  Set fld = tbldef.Fields(strField)
  
Select Case intPropType
  Case dbText
    fld.Properties(strProperty).Value = CStr(varValue)
  Case dbLong
    fld.Properties(strProperty).Value = CLng(varValue)
  Case Else
    fld.Properties(strProperty).Value = varValue
End Select
  tbldef.Fields.Refresh
  
  SetFieldProperty = True
  
Exit_SetFieldProperty:
  On Error Resume Next
  Set fld = Nothing
  Set tbldef = Nothing
  Set MyProp = Nothing
Exit Function

Err_SetFieldProperty:
  Select Case Err
  Case 0    'insert Errors you wish to ignore here
    Resume Next
  Case 3270 'property doesn't exist
    Set MyProp = fld.CreateProperty(strProperty)
    MyProp.Type = intPropType
    MyProp.Value = varValue
    fld.Properties.Append MyProp
    Resume Next
  Case Else 'All other errors will trap
    Beep
    MsgBox Err.Number & "; " & Err.Description, , "Error in function basObjectHandlers.SetFieldProperty"
  Resume Exit_SetFieldProperty
  End Select
  Resume 0  'FOR TROUBLESHOOTING
End Function


'Comments  :  delete a field property
'             use this to clear a user defined property
'Parameters:  db - Database object
'             strTable - string, Table in which to delete property
'             strField - string, Field from which to delete a property
'             strProperty - string, Property to delete
'Returns   :  true on success
'Created by: Neal A. Kling
'Created   : 3/10/99 8:27:20 AM
Function ClearFieldProperty(db As Database, strTable As String, strField As String, _
      strProperty As String) As Boolean
  On Error GoTo Err_ClearFieldProperty
  Dim tbldef As TableDef
  Dim fld As Field
  Dim prop As Property
  Dim MyProp As Property
  Dim varValue
  
  Set tbldef = db.TableDefs(strTable)
  
  Set fld = tbldef.Fields(strField)
    fld.Properties.Delete strProperty
  
  ClearFieldProperty = True
  
Exit_ClearFieldProperty:
  On Error Resume Next
  'cleanup
  Set fld = Nothing
  Set tbldef = Nothing
  
Exit Function

Err_ClearFieldProperty:
  Select Case Err
  Case 0    'insert Errors you wish to ignore here
    Resume Next
  Case 3270 'property doesn't exist
    Resume Next
  Case 3265 'item not found in collection, ignore
    Resume Next
  Case 3384 'can't delete a built in property
    ClearFieldProperty = False
    Resume Exit_ClearFieldProperty
  Case Else 'All other errors will trap
    Beep
    ClearFieldProperty = False
    MsgBox Err.Number & "; " & Err.Description, , "Error in function basObjectHandlers.ClearFieldProperty"
    Resume Exit_ClearFieldProperty
  End Select
  Resume 0  'FOR TROUBLESHOOTING
End Function


'Comments  :  create table link
'Parameters:  strTableName - string, name of table to link to
'             strBe - string, fully qualified PATH and FILE NAME of back end
'             strLocalTableName - string, optional, name of table in front end
'               if not specified local name will be same as linked table
'Returns   :  true on success
'Created by: John Sass and Neal A. Kling
'Created   : 3/12/99 4:41:10 PM
Function CreateLinkedTableDef(strTableName As String, strBE As String _
                , Optional strLocalTableName As String) As Boolean
On Error GoTo Err_CreateLinkedTableDef
Dim db As Database
Set db = DBEngine(0)(0)
Dim tbl As TableDef
Set tbl = db.CreateTableDef
  If Len(strLocalTableName) > 0 Then
    tbl.name = strLocalTableName
  Else
    tbl.name = strTableName
  End If
  tbl.Connect = ";DATABASE=" & strBE
  tbl.SourceTableName = strTableName

  db.TableDefs.Append tbl
  CreateLinkedTableDef = True
  
Exit_CreateLinkedTableDef:
Exit Function

Err_CreateLinkedTableDef:
  Select Case Err
  Case 0    'insert Errors you wish to ignore here
    Resume Next
  Case 3012 'object already exists
    CreateLinkedTableDef = True
    Resume Next
  Case Else 'All other errors will trap
    Beep
    CreateLinkedTableDef = False
    MsgBox Err.Number & "; " & Err.Description, , "Error in function basObjectHandlers.CreateLinkedTableDef"
  Resume Exit_CreateLinkedTableDef
  End Select
  Resume 0  'FOR TROUBLESHOOTING
End Function


'Comments  :  delete a table link, only deletes link - not table in back end
'Parameters:  strTableName - string, name of table link to be deleted
'Returns   :  true on success
'Created by: Neal A. Kling
'Created   : 3/19/99 3:33:19 PM
Function DeleteTableLink(strTableName As String) As Boolean
On Error GoTo Err_DeleteTableLink
  Dim db As Database
  
  Set db = DBEngine(0)(0)
  db.TableDefs.Delete strTableName
  db.TableDefs.Refresh

  DeleteTableLink = True

Exit_DeleteTableLink:
Exit Function

Err_DeleteTableLink:
  Select Case Err
  Case 0    'insert Errors you wish to ignore here
    Resume Next
  Case 3265      'Item doesn't exist in collection
        Resume Next
  Case Else 'All other errors will trap
    Beep
    MsgBox Err.Number & "; " & Err.Description, , "Error in function basObjectHandlers.DeleteTableLink"
  Resume Exit_DeleteTableLink
  End Select
  Resume 0  'FOR TROUBLESHOOTING
End Function

Function fCreateTable() As Boolean
' I haven't written this one yet.  Every time I start to think about it I realise that
' it'll be so complex with passed arrays of objects which in turn have to be created that
' it's just not worth it.  I used to build this one specifically for each table that I need.

'What I'm doing now is I have a separate db that is shipped with updates.  In it I put any
'new tables that I need in my back end.  In my update code I run this db, passing it the
'path\filename of the back end.  Then the db copies to the back end any new tables that
'don't yet exist.

  fCreateTable = False
End Function

'end *******************************************************************






If not can it been done in sql or in code and how??

Pedro Janssen
-- 
AccessD mailing list
AccessD at databaseadvisors.com
http://databaseadvisors.com/mailman/listinfo/accessd
Website: http://www.databaseadvisors.com



More information about the AccessD mailing list