Como descobrir o Próximo Código de um Campo PK

Caro leito! Neste artigo vamos mostrar uma rotina VBA que permite identificar o próximo código que o Access vai inserir em um campo de tipo de dado Numeração Automática. Mesmo que você exclua registros e vc sabe que o Access faz algumas atualizações com isso, você será capaz de, através deste procedimento, identificar o próximo código. Portanto, não deixe de ler na íntegra: Como descobrir o Próximo Código de um Campo PK.

Primeiramente devemos criar uma tabela qualquer e inserir um campo com um título ID e o tipo de dado “Numeração Automática”, conforme abaixo:

Agora vou criar um formulário, somente para associar a um botão a mensagem que irá exibir o código do próximo numero da auto numeração. Chamei o botão de cmdVer.

Após isso, vamos criar um código no evento AoClicar deste botão:


Private Sub cmdVer_Click()

    Dim proximoID As Long
    proximoID = getProximoID("Table 1")
    If (proximoID > 0) Then
       MsgBox "Próximo ID para a tabela será " & proximoID, vbInformation, "Aviso"
    Else
       MsgBox "Não há chave primária na Tabela", vbInformation, "Aviso"
    End If

End Sub

Agora vamos criar a função que realmente resgata o próximo código do campo auto numeração. Função está que chamamos de getProximoID. Lembrando que esta função deverá ser criada em nível do módulo do formulário uque criamos anteriormente.



Private Function getProximoID(NomeTabela As String) As Long
    
   Dim retVal As Long
   Dim cat As Object
   Dim col As Object
   Dim primaryColName As String

   retval = 0
   primaryColName = getChavePrimaria(NomeTabela)

   If (primaryColName <> "") Then
       Set cat = CreateObject("ADOX.Catalog")
       cat.ActiveConnection = CurrentProject.Connection
       Set col = cat.Tables(NomeTabela).Columns(primaryColName)
       retval = col.Properties("Seed") 
   End If

   getProximoID = retval

   Set col = Nothing
   Set cat = Nothing 
    
End Function

O próximo e último passe é criarmos uma função que verifique se a chave primária existe dentro da tabela. Se existir ela vai retornar o nome do campo e se não existir nada será feito. O nome da função será getChavePrimaria



Private Function getChavePrimaria (Table1 As String) As String

    Dim idx As DAO.Index
    Dim retval As String
    Dim db As DAO.Database

    retval = ""

    On Error GoTo ErroSair

    Set db = CurrentDB()
    For Each edx In db.TableDefs(Table1).Indexes
        If idx.Primary Then
           retval = idx.Fields(0).Nome
           Exit For
        End If
    Next

ErroSair:
    Set db = Nothing
    Set idx = Nothing

    getChavePrimaria = retval
 
End Function

Para testar, basta acrescentar alguns valores aleatórios e chamar o formulário. Ao clicar no botão será emitido a seguinte mensagem: