Criando um campo Autonumeração por código

Temos dois métodos para criar um campo Autonumeração por meio de código. Um requer a execução de uma declaração SQL DDL "Create Table", e a outra usa um Append em VBA para incluir um flag dbAutoIncrField na propriedade Atributos do campo.

Autores: Dev Hashish

Parq a criação por meio de consulta DDL, veja este artigo.

Para criar o campo usando VBA e DAO, use esta função:

'  ********* Início do Código ***********
'  Este código foi escrito originalmente por by Dev Ashish
' Ele não deve ser alterado ou distribuído,
' exceto como parte de um aplicativo.
' Use-o livremente em qualquer aplicativo,
' desde que esta nota de copyright permaneça inalterada.
'
' Código cortesia de 
' Dev Ashish
'
Function fCreateAutoNumberField( _
                ByVal strTableName As String, _
                ByVal strFieldName As String) _
                As Boolean
'
'   Cria um campo Autonumeração com nome = strFieldName
'   na tabela strTableName.
'
'   Aceita
'       strTableName:   Nome da tabela onde vai ser criado o campo
'       strFieldName:   Nome do novo campo
'   Returns 
'       Verdadeiro se bem sucedido, Falso se não
'

On Error GoTo ErrHandler
Dim db As DAO.Database
Dim fld As DAO.Field
Dim tdf As DAO.TableDef

    Set db = Application.CurrentDb
    Set tdf = db.TableDefs(strTableName)
    '   Primeiro cria o campo com tipo de dados = Inteiro longo
    Set fld = tdf.CreateField(strFieldName, dbLong)
    With fld
        '   Acrescentar dbAutoIncrField a Atributos
        '   diz ao Jet que é um campo Autonumeração
        .   Attributes = .Attributes Or dbAutoIncrField
    End With
    With tdf.Fields
        .Append fld
        .Refresh
    End With
    
    fCreateAutoNumberField = True
    
ExitHere:
    Set fld = Nothing
    Set tdf = Nothing
    Set db = Nothing
    Exit Function
ErrHandler:
    fCreateAutoNumberField = False
    With Err
        MsgBox "Erro" & .Number & vbCrLf & .Description, _
            vbOKOnly Or vbCritical, "CreateAutonumberField"
    End With
    Resume ExitHere
End Function
'  ********* Final do Código ***********