[AccessD] changing Field Size programmatically

Tina Norris Fields tinanfields at torchlake.com
Fri Mar 1 09:22:49 CST 2013


John,
Thanks for posting that link.  That's a very useful page, indeed.
T

Tina Norris Fields
tinanfields at torchlake.com
231-322-2787

On 2/28/2013 11:16 PM, John Bodin wrote:
> Hi Steve,
>
> Used this code in an A2010 app, worked real well.  It is free, according to the web-site.  Here's the link and the code for just the modify field size routine.  Good luck.
>
> http://aislebyaisle.com/access/vba_backend_code.htm
>
> '
> ' Free Code from http://aislebyaisle.com/access/vba_backend_code.htm
> '
> '--------------------------------------------------------------------------------
> '
> ' MSysObjects TYPES:
> ' 1 = Tables
> ' 6 = Attached Tables
> ' -32768 = Forms
> ' 5 = Queries
> ' -32764 = Reports
> ' -32761 = Modules
> '--------------------------------------------------------------------------------
> 'Change Field Size (for text fields)
> 'The function ChangeFieldSize works both if the table is linked or local, because the code checks what kind of table it is. This calls GetIndexes which is listed separately at the bottom of this page. The subroutine CallChangeFieldSize has sample code to call the function.
>    
>
>
> Function ChangeFieldSize(TblName As String, FldName As String, NewSize As Byte)
> Dim Td As TableDef
> Dim db As Database
> Dim DbPath As Variant
> Dim FldPos As Integer
> Dim rs As Recordset
> Dim IdxNames As Variant
> Dim IdxFldName As String
> Dim IdxNum As Integer
> Dim x As Integer
>
> 'get back end path of linked table
>      DbPath = DLookup("Database", "MSysObjects", "Name='" & TblName & "' And Type=6")
>      If IsNull(DbPath) Then
>          Set db = CurrentDb 'if local table
>      Else
>          Set db = OpenDatabase(DbPath) 'if linked table
>          If Err <> 0 Then
>              'failed to open back end database
>              Exit Function
>          End If
>          'in case back end has different table name than front end
>          TblName = DLookup("ForeignName", "MSysObjects", "Name='" & TblName & "' And Type=6")
>      End If
>
> 'get table
>      Set Td = db.TableDefs(TblName)
>      If Err <> 0 Then
>          'failed to get table
>          GoTo Done
>      End If
>
> 'change field size
>      If Td.Fields(FldName).Size <> NewSize Then
>          With Td
>          
>              On Error Resume Next
>              If NewSize > 0 And NewSize < 256 Then 'text field
>                  .Fields.Append .CreateField("TempFld", dbText, NewSize)
>              Else '0 is memo field
>                  .Fields.Append .CreateField("TempFld", dbMemo)
>              End If
>              
>              .Fields("TempFld").AllowZeroLength = True 'personal preference
>              FldPos = .Fields(FldName).OrdinalPosition
>              .Fields("TempFld").OrdinalPosition = FldPos
>              
>              Set rs = db.OpenRecordset(TblName)
>              While Not rs.EOF
>                  rs.Edit
>                  rs!TempFld = rs.Fields(FldName)
>                  rs.Update
>              rs.MoveNext
>              Wend
>              rs.Close
>              
>              'get indexes used by this field
>              IdxNames = GetIndexes(Td, FldName)
>              'temporarily delete indexes used by this field
>              For IdxNum = UBound(IdxNames, 2) To 0 Step -1
>                  If IdxNames(0, IdxNum) > "" Then .Indexes.Delete IdxNames(0, IdxNum)
>              Next
>              
>              'delete old field
>              .Fields.Delete FldName
>              'rename new field to original
>              .Fields("TempFld").Name = FldName
>          
>              'restore indexes
>              For IdxNum = 0 To UBound(IdxNames, 2)
>                  If IdxNames(0, IdxNum) > "" Then
>                      Dim Idx As Index
>                      Set Idx = .CreateIndex(IdxNames(0, IdxNum))
>                      'parse comma-delimited field names and add them to index
>                      While Len(IdxNames(8, IdxNum)) > 1
>                          x = InStr(IdxNames(8, IdxNum), ",")
>                          IdxFldName = Left(IdxNames(8, IdxNum), x - 1)
>                          Idx.Fields.Append Td.CreateField(IdxFldName)
>                          IdxNames(8, IdxNum) = Mid(IdxNames(8, IdxNum), x + 1)
>                      Wend
>                      'assign properties to index
>                      For x = 1 To 7
>                          Idx.Properties(x) = IdxNames(x, IdxNum)
>                      Next
>                      'add the index
>                      .Indexes.Append Idx
>                  End If
>              Next
>              
>          End With
>          
>          If Err <> 0 Then GoTo Done
>              
>      End If
>
> ChangeFieldSize = True  'defaults to false if it fails to get here
>
> Done:
> If Not db Is Nothing Then db.Close
> End Function
>
>
> Sub CallChangeFieldSize()
> Dim Result As Boolean
>
> 'sample call:
> Result = ChangeFieldSize("Table1", "Field1", 15)
> Debug.Print Result
> End Sub
>
> '--------------------------------------------------------------------------------
> 'Get Indexes In Table
> 'Access won't let you change a field type or a field size if that field belongs to an index. Therefore, it's necessary to delete the index, modify the field, and restore the index. The function GetIndexes finds all the indexes containing the given field. It returns an array containing the index names and all the index properties so that you can restore them later. This function is called by the functions ChangeFieldSize and ChangeFieldType above.
>    
>
>
> Function GetIndexes(Td As TableDef, FldName As String)
> 'Returns array of indexes containing the specified field,
> ' the first index starting at Idx(1), so that
> ' Ubound(2, Idx) equals the number of indexes having the specified field
> Dim IdxNum As Integer, FldNum As Integer, PropNum As Integer
> Dim IdxNames() As String 'array to hold indexes
> ReDim IdxNames(8, 0) 'first dimension contains the index properties and field names
>                  'second dimension represents index number
> Dim FldNames As String
>
>      For IdxNum = 0 To Td.Indexes.Count - 1
>          FldNames = ""
>          For FldNum = 0 To Td.Indexes(IdxNum).Fields.Count - 1
>              'concatonate field names
>              FldNames = FldNames & Td.Indexes(IdxNum).Fields(FldNum).Name & ","
>              'if index contains the field we're looking for ...
>              If FldName = Td.Indexes(IdxNum).Fields(FldNum).Name Then
>                  If IdxNum > 0 Then ReDim Preserve IdxNames(8, IdxNum)
>                  'properties go into first 7 places of first dimension
>                  For PropNum = 0 To 7
>                      IdxNames(PropNum, IdxNum) = Td.Indexes(IdxNum).Properties(PropNum)
>                  Next
>              End If
>          Next
>          'field names go into 8th place of first dimension
>          If IdxNames(8, UBound(IdxNames, 2)) = "" Then IdxNames(8, UBound(IdxNames, 2)) = FldNames
>      Next
>      
>      GetIndexes = IdxNames
> End Function
>
> -----Original Message-----
> From: accessd-bounces at databaseadvisors.com [mailto:accessd-bounces at databaseadvisors.com] On Behalf Of Steve Schapel
> Sent: Thursday, February 28, 2013 11:05 PM
> To: AccessD at databaseadvisors.com
> Subject: [AccessD] changing Field Size programmatically
>
> Hi.  Anyone know how to do this?...
>
> I have a number of fields, all of them Text data type, in a backend Access 2003 database, that I want to change the Field Size property.
>
> Aside from getting hold of each copy of the mdb file, and manually editing, is there a way I can do this in code from within the Frontend application?
>
> Thanks.
>
> Regards
> Steve
>



More information about the AccessD mailing list