[Resolvido]Aplicar Código de numeração sequencial para ler tabela no Back And

Amigos tenho o seguinte código...


Private Sub Form_BeforeUpdate(Cancel As Integer)
'Verifica se o campo ID está nulo. Se estiver
'significa que é um novo registro.
If IsNull(ID) Then
'Atribui ao campo o próximo número livre dentro
'do campo ID na tabela Detento.
ID.Value = numeroLivre("Detentos", "ID")
End If
End Sub

Preciso que ele identifique tabela detentos no Back End (CurrentPath)

Se alguem puder me ajudar,... fico Grato

Hary,

Utilize a função
Function NumeroLivre(CampoID as string,NomeTabela as string, EnderecoBD as string) As Long
'criada por Alexandre Neves
'em 2011-06-15
'para Harysohn
'do fórum MaximoAccess
Dim Rst As DAO.Recordset
Set Rst = CurrentDb.OpenRecordset("SELECT " & CampoID & " FROM " & NomeTabela & " IN '" & EnderecoBD & "' ORDER BY ID;")
If Rst.RecordCount = 0 Or IsNull(Rst(0)) Then
NumeroLivre = 1
Else
Rst.MoveLast
NumeroLivre = Rst(0) + 1
End If
Set Rst = Nothing
End Function

No código
ID.Value = numeroLivre("ID","Detento",CurrentPath)

Caro Alexandre este código de numeracao sequencial eu preciso para a
seguinte situação

1 - A chave primaria não é numeração automática (é campo número)

2 - ao excluir um registro intermediário o código checa se há lacunas na numeracao
da chave primaria e grava o arquivo novo com este numero

Assim:

1

2

3

'''''''

5

6

(novo registro = 4)



de que forma posso adaptar este código para que leia a tabela no back end
(para isso irei usar o arquivo de paramentos em variáveis)

Dim NomeBanco as String

Dim LocalBanco as String

Dim StrPath

NomeBanco = Sypen_be.Accde

LocalBanco = DirBancoDados (caminho no arquivo de parametros

Dim StrPath = LocalBanro & NomeBanco



Isso ja funciona para RecorSource e RecordSet, preciso adptá-lo para o
código acima



Cumprimentos

Caro Alexandre, bom dia.

Apliquei o código que fez para mim e funcionou perfeitamente para gravar novos registros com numeração subsequente.. Eis como ficou:


Private Sub btnNovo_Click()
'On Error GoTo Err_btnNovo

Parametros_de_Inicializacao "SysPen.par"
Dim Db As DAO.Database
Dim ws As DAO.Workspace
Dim rs As DAO.Recordset

Dim NomeBD As String
Dim StrPath As String

Dim I, II


NomeBD = "Syspen_Be.Accdb" 'Váriável para o nome do BD
StrPath = DirBancoDados & NomeBD 'Váriável para Caminho contido no Arquivo de Parâmetros + Variável do Nome do BD (C:\Syspen\Syspen_Be.Accdv)
If Me.txtID.Value = "" Then GoTo Continuar

If Not IsNull(Me.txtID) Then
II = MsgBox("ESTE REGISTRO JA EXISTE!", vbCritical, "Atenção!")
Call LimpaCampos
Cancel = True
Exit Sub

Continuar:

Else
'Verifica se o campo codFunc está nulo. Se estiver
'significa que é um novo registro.
If IsNull(txtID) Then
'Atribui ao campo o próximo númerosubsequente dentro
'do campo ID na tabela Detentos.
Me.txtID.Value = NumeroLivre1("ID", "Detentos", StrPath) 'Aqui recebe a váriável do Caminho completo (StrPath)


No entanto Amigão precisaria que na função corresse a seguinte rotina.:


Function NumeroLivre(argTabela As String, argCampo As String) As Long

Dim I As Long

I = 0

Do

I = I + 1

'Verifica se existe no campo e tabela informados o valor
'atual da variável de contagem.
If IsNull(DLookup(argCampo, argTabela, argCampo & "=" & I)) Then
'Se não existir retorna o valor
NumeroLivre = I
Exit Function
End If
Loop

End Function

** Esta função do outro código procura na tabela Detentos algum número vago anterior ao último registros, caso exista grava o novo registro com esse núimero ex:

1
2
.... 'Grava o novo registro com o número 3 (caso não haja lacunas na numeração sequencial grava o próximo número depois do último
4
5

Podeendo ajudar, fico-lhe imensamente Grato

Saudaçãoes

Não esquecer o resolvido

Nao está resolvido não amigão... estou esperando nosso Amigo alexandre, pois preciso de uma modificação.. se observar abaixo onde escrevi ....


No entanto Amigão precisaria que na função corresse a seguinte rotina.:


Function NumeroLivre(argTabela As String, argCampo As String) As Long

Dim I As Long

I = 0

Do

I = I + 1

'Verifica se existe no campo e tabela informados o valor
'atual da variável de contagem.
If IsNull(DLookup(argCampo, argTabela, argCampo & "=" & I)) Then
'Se não existir retorna o valor
NumeroLivre = I
Exit Function
End If
Loop

End Function

**
Esta função do outro código procura na tabela Detentos algum número
vago anterior ao último registros, caso exista grava o novo registro com
esse núimero ex:

1
2
.... 'Grava o novo registro com o número 3 (caso não haja lacunas na numeração sequencial grava o próximo número depois do último
4
5

Podeendo ajudar, fico-lhe imensamente Grato


Grato

Para atribuir primeiro número disponível
Function NumeroLivre(CampoID as string,NomeTabela as string, EnderecoBD as string) As Long
'criada por Alexandre Neves
'em 2011-06-15
'para Harysohn
'do fórum MaximoAccess
Dim Rst As DAO.Recordset,I as integer
Set Rst = CurrentDb.OpenRecordset("SELECT " & CampoID & " FROM " & NomeTabela & " IN '" & EnderecoBD & "' ORDER BY ID;")
If Rst.RecordCount = 0 Or IsNull(Rst(0)) Then
NumeroLivre = 1
Else
i=1
do
If rst(0)<>i then
NumeroLivre = i
exit do
end if
i=i+1
rst.movenext
loop
End If
Set Rst = Nothing
End Function

Caro alexandre... esta função e ubstituo no módulo..

No form como eu deixo?
como esta escrito lá acima?


Grato

Sim, no form será da mesma forma

Perfect, Congratulations!


Obrigado

Caro alexandre , inseri alguns registros... estava normal

Agora...da erro nessa linha no modulo


Else
I = 1
Do
If Rst(0) <> I Then
NumeroLivreVago = I
Exit Do

Fala que nao ha nenhum registro atual...

Não sei o que terá no registo.
No entanto, substitua
If rst(0)<>i then
por
If IsNull(Rst(0)) or Rst(0)="" or rst(0)<>i then

Caro alexandre... ainda continua.. nehum registro atual...

o que fazer?

Depois de
Set Rst = CurrentDb.OpenRecordset("SELECT " & CampoID & " FROM " & NomeTabela & " IN '" & EnderecoBD & "' ORDER BY ID;")
coloque
Msgbox rst.recordcount

e informe o resultado mostrado

1

Só a título de informação

supondo que tenho os registros de 1 a 10

Se eu apago o 7... ele grava o 7........ mas só esse...

Se apago o 7 e 8 ele não grava nenhum..

E não adiciona novos

agora coloque
Set Rst = CurrentDb.OpenRecordset("SELECT " & CampoID & " FROM " & NomeTabela & " IN '" & EnderecoBD & "' ORDER BY ID;")
coloque
rst.movelast:rst.movefirst
Msgbox rst.recordcount

veja se mantém em 1

609.... E Mensagem de erro nao ha registro atual


o numero de registros na tabela

Tente
Set Rst = CurrentDb.OpenRecordset("SELECT " & CampoID & " FROM " & NomeTabela & " IN '" & EnderecoBD & "' WHERE Not IsNull(ID) ORDER BY ID;")

mesmo erro..
Amigão estive lendo sobre este erro.. parece-me ser em questão de relacionamento...

Esta tabela é relacionada... porém é a tabela primaria

Se carregar parte da bd, tenta-se resolver

Caro alexandre perdoando-me do trabalho...


https://www.dropbox.com/s/9mqak6nvq4h5cdr/Desvinculo.rar

Boa noite

Hary,

Já abri a bd. Julgo que o código é o existente na SYSPEN. Para não andar à procura, o que faz para encontrar esse erro?

Não entendi amigo??

Qual código?

Anexo tem o Arquivo Syspen.Par... nele tem que estar o caminho para o BD

DirBancoDados:=C:\Syspen\

Esse parametro somado com a Variável NomeBD

Perfaz o endereço da BD

C:\syspen\Syspen_be.accdb... funciona em todos os outros códigos, inclusive no seu que me enviou anteriormente.. que preenche a numeração normal...

Quando diz que a função não executa como pretende, está-se a referir a lago que faz, quer seja entrar num controlo quer seja clicar num comando, etc. Pretendo fazer exactamente igual para avaliar a falha.

Abre o FOrm Cadastro...
Clica no botão que esta com o texto em RED... ao clicar executa uma clausula IF e libera os campos, mudando o Caption e cor do Botão...

Caso Azul.. vai para novo registro... Checa se alguns campos estão em branco...

Apos preencher alguns campos requeridos... no final do código do botão chama a função

Call NovoRegistro (que é a que executa o recordSet)

Saudações

Não vejo nenhum formulário Cadastro...
Apenas tem o FrmDetentoConsulta

Desculpe então.. Deletei o errado
ja lhe envio

POde baixa o mesmo link novamente Amigão..

Grato

Hary,

Utilize

Function NumeroLivreVago(CampoID As String, NomeTabela As String, EnderecoBD As String) As Long
'criada por Alexandre Neves
'em 2011-06-15
'para Harysohn
'do fórum MaximoAccess
Dim Rst As DAO.Recordset, I As Integer
Set Rst = CurrentDb.OpenRecordset("SELECT " & CampoID & " FROM " & NomeTabela & " IN '" & EnderecoBD & "' WHERE Not IsNull(ID) ORDER BY ID;")

If Rst.RecordCount = 0 Or IsNull(Rst(0)) Then
NumeroLivreVago = 1
Else
I = 1
Do
If Rst.EOF Then
NumeroLivreVago = I
Exit Do
ElseIf IsNull(Rst(0)) Or Rst(0) = "" Or Rst(0) <> I Then
NumeroLivreVago = I
Exit Do
End If
I = I + 1
Rst.MoveNext
Loop
End If
Set Rst = Nothing
Exit Function
MostraErro:
MsgBox err.Number & vbCr & err.Description
End Function

Alexandre.. Boa tarde .. creio que boa noite ai..

Só a título de aprendizado, poderia me explicar com o que estava relacionado o problema..

Se puder fico-lhe extremamente grato

Saudações

No ciclo, quando o recordset chegava ao fim tinha de ser verificada a condição rst.EOF (end of file) e não aceitava que a comparação fosse IsNull(Rst(0)) Or Rst(0) = ""

Great..

Perfect!

Saudações