Beispiel:

Option Explicit
 
Public Enum eAlterType
  atAdd = 1
  atChange = 2
  atDrop = 3
End Enum
 
Public Enum eDataType
  dtBinary = 9
  dtBoolean = 1
  dtByte = 2
  dtCurrency = 5
  dtDate = 8
  dtDouble = 7
  dtInteger = 3
  dtLong = 4
  dtMemo = 12
  dtSingle = 6
  dtText = 10
  dtCounter = 99
End Enum
 
Public Function A2XADOAlterField(peAlterType As eAlterType, _
                              psTable As String, _
                              psFieldName As String, _
                              peDataType As eDataType, _
                              Optional plLen As Long, _
                              Optional plStart As Long, _
                              Optional plCount As Long, _
                              Optional psDbs _
                              As String = vbNullString) _
                              As Integer
  '// =====================================================
  '// Methode   | Simulation der Datendefinitionsabfragen
  '//           | bezüglich der Feldbearbeitung, wie z.B.
  '//           | Hinzufügen eines Feldes, Ändern des
  '//           | Feldtypes oder Löschen eines Feldes
  '// -----------------------------------------------------
  '// Parameter | peAlterType  - Feldbearbeitungsoption
  '//           | psTable     - Name der Tabelle
  '//           | psFieldName - Name des neuen Feldes
  '//           | peDataType  - Datentyp
  '//           | plLen       - Optional die Länge eines
  '//           |               Textfeldes
  '//           | plStart     - Optional der Startwert
  '//           |               eines Counterfeldes
  '//           | plCount     - Optional die Schrittweite
  '//           |               eines Counterfeldes
  '//           | psDbs       - Optional Pfad & Name der DB
  '//           | Hinweis     - Die Enums eDataType und
  '//           |               eAlterType sollten vorab
  '//           |               auf Modulebene deklariert
  '//           |               sein!
  '// -----------------------------------------------------
  '// Rückgabe  | Integer - True = OK, False = Fehler
  '// -----------------------------------------------------
  '// Erstellt  | Manuela Kulpa
  '//           | EDV Innovation & Consulting - Dormagen
  '// =====================================================
 
  On Error GoTo HandleErr
  ' Verweis auf ActiveX Data Object 2.X muss gesetzt sein!
  Dim cnn As ADODB.Connection
 
  Dim sSql       As String
  Dim sFieldType As String
 
  ' Datenbank öffnen
  If Len(psDbs) > 0 Then
    Set cnn = New ADODB.Connection
    cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
             "Data Source=" & psDbs
  Else
    Set cnn = CurrentProject.Connection
  End If
 
  ' Feldtype bestimmen
  sFieldType = A2XCheckFieldType(CInt(peDataType))
 
  ' SQL-Syntax zusammen stellen
  sSql = "ALTER TABLE " & psTable
  Select Case peAlterType
    Case atAdd ' Hinzufügen
      sSql = sSql & " ADD COLUMN " & psFieldName & _
             " " & sFieldType
    Case atChange ' Verändern
      sSql = sSql & " ALTER COLUMN " & psFieldName & _
             " " & sFieldType
    Case atDrop ' Löschen
      sSql = sSql & " DROP COLUMN " & psFieldName
  End Select
 
  If peAlterType <> atDrop Then
    ' Falls Textfeld, wurde eine Länge angegeben
    If peDataType = dtText Then
      If plLen > 0 And plLen < 256 Then
        sSql = sSql & "(" & plLen & ")"
      End If
      ' Falls Counter, wurde ein Startwert angegeben
    ElseIf peDataType = dtCounter Then
      If plStart > 0 Then
        sSql = sSql & "(" & plStart
        ' Falls Startwert, wurde eine Schrittweite
        ' angegeben
        If plCount > 0 Then
          sSql = sSql & "," & plCount & ")"
        Else
          sSql = sSql & ")"
        End If
      End If
    End If
  End If
 
  cnn.Execute sSql
  A2XADOAlterField = True
 
HandleExit:
  On Error Resume Next
  If Not cnn Is Nothing Then cnn.Close: Set cnn = Nothing
  Exit Function
 
HandleErr:
  Select Case Err.Number
    Case Else
      MsgBox "Fehler " & Err.Number & ": " & _
             Err.Description, vbCritical, _
             "basADO.A2XADOAlterField"
  End Select
  Resume HandleExit
End Function
 
Public Function A2XCheckFieldType(piDataType As Integer) _
                                  As String
  '// =====================================================
  '// Methode   | Ermittelt den SQL-Datentyp-Syntax
  '// -----------------------------------------------------
  '// Parameter | piDataType - Angabe des Datentypes
  '// -----------------------------------------------------
  '// Rückgabe  | String - s.o.
  '// -----------------------------------------------------
  '// Erstellt  | Manuela Kulpa
  '//           | EDV Innovation & Consulting - Dormagen
  '// =====================================================
 
  Dim sTmp As String
 
  Select Case piDataType
    Case dtBinary
      sTmp = "BINARY"
    Case dtBoolean
      sTmp = "BIT"
    Case dtByte
      sTmp = "BYTE"
    Case dtCurrency
      sTmp = "CURRENCY"
    Case dtDate
      sTmp = "DATE"
    Case dtDouble
      sTmp = "DOUBLE"
    Case dtInteger
      sTmp = "SMALLINT"
    Case dtLong
      sTmp = "LONG"
    Case dtMemo
      sTmp = "MEMO"
    Case dtSingle
      sTmp = "SINGLE"
    Case dtText
      sTmp = "TEXT"
    Case dtCounter
      sTmp = "COUNTER"
  End Select
 
  A2XCheckFieldType = sTmp
 
End Function