John Bodin
jbodin at sbor.com
Thu Feb 28 22:16:55 CST 2013
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
--
AccessD mailing list
AccessD at databaseadvisors.com
http://databaseadvisors.com/mailman/listinfo/accessd
Website: http://www.databaseadvisors.com