Dim Fld As Field
Dim n()  As Integer, m As Integer
 
Set DB = DBEngine.OpenDatabase(sDBName, False, False)
 
'Anzahl der vorhandenen Textfelder ermitteln
For Each Fld In DB.TableDefs(sTabelle).Fields
    If Fld.Type = dbText Then m = m + 1
Next
 
If m = 0 Then Exit Sub
Redim n(m)
 
Set RS = DBEngine.OpenRecordset(sTabelle)
 
'Längsten Textinhalt in allen Feldern ermitteln
Do While Not RS.EOF
   m = 0 
   For Each Fld In RS.Fields
          If Fld.Type = dbText Then
             If Len(Fld.Value) > n(m) Then n(m) = Len(Fld.Value)
             m = m + 1
          End If
   Next
   Rs.MoveNext
Loop
 
RS.Close
m = 0
 
'Neue Länge zuweisen
For Each Fld In DB.Tabledefs(sTabelle).Fields
    If Fld.Type = dbText Then
        Fld.Size = n(m) + 1
        m = m + 1
    End If
Next 
 
DB.Close