Insert Fields into a table

InFlight

InFlight

User
Local time
Tomorrow, 07:59
Joined
Jun 11, 2015
Messages
130
Hi
I found this code and using it. My problem is i am addind a field called PhoneNum.
it adds it ok but i want to change the InPut Mask to
varMask = "!\(999" & Chr(34) & ")" & Chr(34) & "900\ 0000;;_"



Code: 
Public Sub fSetOrdinal(db As Database, strTbl As String, intOrdinal As Integer, strNewFieldName As String)
    ' ---------------------------------------------------------
    ' Name:     fSetOrdinal
    ' Purpose:  To add a new field into a table at a specific Ordinal Number
    ' Inputs:   db - the database to use
    '           strTbl - name of the table to add field to
    '           intOrdinal - ordinal position for new field
    '           strNewFieldName - name for new field to be added
    ' Returns:  Nothing
    ' ----------------------------------------------------------
 
 
    Dim tbl As TableDef
    Dim fld As Field
    Dim fldLoop As Field
    Dim intLoop As Integer
 
    Set tbl = db.TableDefs(strTbl)
 
    ' check for existence of same column name
    For Each fldLoop In tbl.Fields
        If fldLoop.Name = strNewFieldName Then
            MsgBox ("This column (field) name [" & strNewFieldName & "] already exists in table: " & strTbl)
            Exit Sub
        End If
    Next
 
    'ensure all fields have a unique ordinal value - ie: reset ALL ordinals
    tbl.Fields.Refresh
    For intLoop = 0 To tbl.Fields.Count - 1
        tbl.Fields(intLoop).OrdinalPosition = intLoop
    Next
    tbl.Fields.Refresh
 
 
    '***Add NEW Column***
 
    ' loop thru all fields and ensure no field has the same ordinal that you want to add
    For Each fldLoop In tbl.Fields
        ' if existing field has same ordinal then increase all subsequent field ordinals by 1
        If fldLoop.OrdinalPosition = intOrdinal Then
            For intLoop = tbl.Fields.Count - 1 To intOrdinal Step -1
                tbl.Fields(intLoop).OrdinalPosition = intLoop + 1
            Next
        End If
    Next
    tbl.Fields.Refresh
 
    ' to make function more robust you could pass these field parameters also
    ' i did not just for demo purposes
    Set fld = tbl.CreateField(strNewFieldName, dbText, 10)
    fld.Properties("Required").Value = False
    fld.Properties("AllowZeroLength").Value = True
    fld.OrdinalPosition = intOrdinal
    tbl.Fields.Append fld
    tbl.Fields.Refresh
End Sub
 
Advise not to bother setting these properties in table. Do it in textbox on form.

Why do you even need code to add a new field? How often does this happen?
 
I have several clients, that i have to add field's in the back end. I am going to add code in the front end so i don't have to upload and change them, just supply a new front end. Each one has the same DB but different data in them. The new front end has some forms changed that need the new fields.
 
add this to your code:
Code: 
Private Function fnNewProperty(ByRef fld As DAO.Field, ByVal sPropertyName As String, ByVal pPropertyType As DataTypeEnum, ByVal pValue As Variant)

    On Error GoTo err_handler
    fld.Properties(sPropertyName).value = pValue
    
exit_handler:
    Exit Function
    
err_handler:
    If Err.Number = 3270 Then 'property not found
        fld.Properties.Append CurrentDb.CreateProperty(sPropertyName, pPropertyType, pValue)
        Resume
    Else
        MsgBox Err.Number & ": " & Err.Description
        Resume exit_handler
    End If
End Function
and change this part:
Code: 
    ' to make function more robust you could pass these field parameters also
    ' i did not just for demo purposes
    Set fld = tbl.CreateField(strNewFieldName, dbText, 10)
    fld.Properties("Required").Value = False
    fld.Properties("AllowZeroLength").Value = True

to:
Code: 
    ' to make function more robust you could pass these field parameters also
    ' i did not just for demo purposes
    Set fld = tbl.CreateField(strNewFieldName, dbText, 10)
    Call fnNewProperty(fld, "Required", dbInteger, 0)
    Call fnNewProperty(fld, "AllowZeroLength", dbInteger, -1)
    Call fnNewProperty(fld, "InputMask", dbText, "!\(999" & Chr(34) & ")" & Chr(34) & "900\ 0000;;_")
 
What about a Yes/No field. this isn't working
Code: 
     Set fld = tbl.CreateField(strNewFieldName, dbBoolean, 2)
                fld.Properties.Append fld.CreateProperty("Format", "True/False")
 
dbBoolean can be either a -1 (true) or 0 (false).
you missed one parameter on your last line of code:

…("Format", dbText, "True/False")

you passed it to the func I gave, so you will not get error when the property still does not exists.
 
Last edited:
The new code . It works.
Thanks all
Code: 
'--------------------------------------------------
Private Sub cmdTest_Click()
    '1 = Text
    '2 = Memo
    '3 = Number
    '4 = Date/Time
    '5 = Currency
    '6 = AutoNumber
    '7 = Yes/No
    '8 = Text with Mask

    On Error GoTo cmdTest_Click_Error
    
    Dim db As Database
    Dim varPhoneMask, varBankMask, strNewField, strTbl As String
    Dim intOrdinal As Integer

    varPhoneMask = "!\(999" & Chr(34) & ")" & Chr(34) & "900\ 0000;;_"
    varBankMask = "!00\ 0000\-0000000\-00;;"

    Set db = CurrentDb
    strTbl = "Addresses"

    intOrdinal = 2
    Call fSetOrdinal(db, strTbl, intOrdinal, "PhoneNo", 8, 12, "")
    
    intOrdinal = 3
    Call fSetOrdinal(db, strTbl, intOrdinal, "BankAcc", 9, 12, "")

    intOrdinal = CurrentDb.TableDefs(strTbl).Fields.Count
    Call fSetOrdinal(db, strTbl, intOrdinal, "ClubPrize", 7, 0, "")
    
    
    On Error GoTo 0
    Exit Sub

cmdTest_Click_Error:

    MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure cmdTest_Click, line " & Erl & "."
End Sub
'--------------------------------------------------
Public Sub fSetOrdinal(db As Database, strTbl As String, intOrdinal As Integer, strNewFieldName As String, fldType As Integer, varFldLen As Integer, varMask As String)
    On Error GoTo fSetOrdinal_Error
    ' ---------------------------------------------------------
    ' Name:     fSetOrdinal
    ' Purpose:  To add a new field into a table at a specific Ordinal Number
    ' Inputs:   db - the database to use
    '           strTbl - name of the table to add field to
    '           intOrdinal - ordinal position for new field
    '           strNewFieldName - name for new field to be added
    ' Returns:  Nothing
    ' ----------------------------------------------------------
    
    Dim tbl As TableDef
    Dim fld As Field
    Dim fldLoop As Field
    Dim intLoop As Integer
 
    Set tbl = db.TableDefs(strTbl)
 
    ' check for existence of same column name
    For Each fldLoop In tbl.Fields
        If fldLoop.Name = strNewFieldName Then
            MsgBox ("This column (field) name [" & strNewFieldName & "] already exists in table: " & strTbl)
            Exit Sub
        End If
    Next
 
    'ensure all fields have a unique ordinal value - ie: reset ALL ordinals
    tbl.Fields.Refresh
    For intLoop = 0 To tbl.Fields.Count - 1
        tbl.Fields(intLoop).OrdinalPosition = intLoop
    Next
    tbl.Fields.Refresh
 
 
    '***Add NEW Column***
 
    ' loop thru all fields and ensure no field has the same ordinal that you want to add
    For Each fldLoop In tbl.Fields
        ' if existing field has same ordinal then increase all subsequent field ordinals by 1
        If fldLoop.OrdinalPosition = intOrdinal Then
            For intLoop = tbl.Fields.Count - 1 To intOrdinal Step -1
                tbl.Fields(intLoop).OrdinalPosition = intLoop + 1
            Next
        End If
    Next
    tbl.Fields.Refresh
 
    ' to make function more robust you could pass these field parameters also
    ' i did not just for demo purposes
    Select Case fldType
        Case 1      ' Text field
            Set fld = tbl.CreateField(strNewFieldName, dbText, varFldLen)
        Case 2      ' Memo field
            Set fld = tbl.CreateField(strNewFieldName, dbMemo)
        Case 3      ' Number field
            Set fld = tbl.CreateField(strNewFieldName, dbLong)
        Case 4      ' Date field
            Set fld = tbl.CreateField(strNewFieldName, dbDate)
        Case 5      ' Currency field
            Set fld = tbl.CreateField(strNewFieldName, dbCurrency, 2)
        Case 6      ' Auto Number field
            Set fld = tbl.CreateField(strNewFieldName, dbLong)
            fld.Attributes = dbAutoIncrField
        Case 7      ' Yes/No field
            Set fld = tbl.CreateField(strNewFieldName, dbBoolean, 2)
        Case 8      ' Text field with Mask
            Set fld = tbl.CreateField(strNewFieldName, dbText, varFldLen)
            
        Case Else
            Set fld = tbl.CreateField(strNewFieldName, dbText, 255)
    End Select
    
    fld.OrdinalPosition = intOrdinal
    tbl.Fields.Append fld
        
    Select Case fldType
        Case 7
            Call fnNewProperty(fld, "Required", dbInteger, 0)
            Call fnNewProperty(fld, "Format", dbText, "Yes/No")
        Case 8
            Call fnNewProperty(fld, "Required", dbInteger, 0)
            Call fnNewProperty(fld, "AllowZeroLength", dbInteger, -1)
            Call fnNewProperty(fld, "InputMask", dbText, "!\(999" & Chr(34) & ")" & Chr(34) & "900\ 0000;;_")
        Case 9
            Call fnNewProperty(fld, "Required", dbInteger, 0)
            Call fnNewProperty(fld, "AllowZeroLength", dbInteger, -1)
            Call fnNewProperty(fld, "InputMask", dbText, "!00\ 0000\-0000000\-00;;")
    End Select

    tbl.Fields.Refresh
    
    On Error GoTo 0
    Exit Sub

fSetOrdinal_Error:

    MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure fSetOrdinal, line " & Erl & "."
End Sub
'--------------------------------------------------
Private Function fnNewProperty(ByRef fld As DAO.Field, ByVal sPropertyName As String, ByVal pPropertyType As DataTypeEnum, ByVal pValue As Variant)

    On Error GoTo err_handler
    fld.Properties(sPropertyName).Value = pValue
    
exit_handler:
    Exit Function
    
err_handler:
    If Err.Number = 3270 Then 'property not found
        fld.Properties.Append CurrentDb.CreateProperty(sPropertyName, pPropertyType, pValue)
        Resume
    Else
        MsgBox Err.Number & ": " & Err.Description
        Resume exit_handler
    End If
End Function
 
I have now changed this so the yesno field displays as check box
Code: 
              Call fnNewProperty(fld, "Required", dbInteger, 0)
            Call fnNewProperty(fld, "Format", dbText, "Yes/No")
            Call fnNewProperty(fld, "DisplayControl", dbInteger, acCheckBox)
 
Cheers for that. did you get the search and replace working. I have a few selling mistakes i would like to fix. Like Descripition to Description
 
Hi
Sorry but I'm not sure what you're referring to. Is that part of this thread or a previous one?
Assume you meant spelling mistakes! :)
 
Back the start of the year or late last year I asked if anyone had a search and replace.
I think it was you that said you had one in a function/ Module
 
Ah yes, I remember now.
I do indeed have a search and replace feature but its built into one of my apps.
I haven't yet done anything about separating out the code.

Suggest you look at the free V-Tools add-in which includes a deep find and replace feature
You can find it here http://www.skrol29.com/us/vtools.php
 
Last edited:
Hi
I tried it. It stopped MZ tools working. I used it to change 1 field and had trouble, so i uninstall it and it uninstalled MS Office. Lucky i did a backup of the system before i installed it
:(
 
That’s interesting. My MZ Tools has also stopped working. I will investigate and report back


Sent from my iPhone using Tapatalk
 
You must log in or register to reply here.

Similar threads

N
Solved Receiving Emails in Access Database using CDO 2000 library
Replies
10
Views
347
sonic8
S
N
Solved How to convert a month into a number in MS Access Query
Replies
7
Views
317
Pat Hartman
P
brucemc777
Solved Take three user selected fields and use an INSERT INTO statement to create a new record in a table that only has those three field AND a Key
Replies
11
Views
544
Pat Hartman
P
arnelgp
Extracting Image from OLE field
Replies
1
Views
388
Jason Lee Hayes
Jason Lee Hayes
essaytee
Is it possible: Query/SQL to dynamically display a record/order/position number, without underlying field from a table
Replies
11
Views
478
essaytee
essaytee

Users who are viewing this thread

Total: 1 (members: 0, guests: 1)
Back
Top Bottom