Insert Fields into a table (1 Viewer)

InFlight

User
Local time
Tomorrow, 03:55
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
 

June7

AWF VIP
Local time
Today, 06:55
Joined
Mar 9, 2014
Messages
5,425
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?
 

InFlight

User
Local time
Tomorrow, 03:55
Joined
Jun 11, 2015
Messages
130
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.
 

arnelgp

..forever waiting... waiting for jellybean!
Local time
Today, 22:55
Joined
May 7, 2009
Messages
19,175
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;;_")
 

InFlight

User
Local time
Tomorrow, 03:55
Joined
Jun 11, 2015
Messages
130
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")
 

arnelgp

..forever waiting... waiting for jellybean!
Local time
Today, 22:55
Joined
May 7, 2009
Messages
19,175
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:

InFlight

User
Local time
Tomorrow, 03:55
Joined
Jun 11, 2015
Messages
130
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
 

InFlight

User
Local time
Tomorrow, 03:55
Joined
Jun 11, 2015
Messages
130
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)
 

InFlight

User
Local time
Tomorrow, 03:55
Joined
Jun 11, 2015
Messages
130
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
 

isladogs

MVP / VIP
Local time
Today, 14:55
Joined
Jan 14, 2017
Messages
18,186
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! :)
 

InFlight

User
Local time
Tomorrow, 03:55
Joined
Jun 11, 2015
Messages
130
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
 

isladogs

MVP / VIP
Local time
Today, 14:55
Joined
Jan 14, 2017
Messages
18,186
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:

InFlight

User
Local time
Tomorrow, 03:55
Joined
Jun 11, 2015
Messages
130
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
:(
 

isladogs

MVP / VIP
Local time
Today, 14:55
Joined
Jan 14, 2017
Messages
18,186
That’s interesting. My MZ Tools has also stopped working. I will investigate and report back


Sent from my iPhone using Tapatalk
 

Users who are viewing this thread

Top Bottom