Utilizando Duas sequencias de Loop's (Loop dentro de um Loop) para atualizar outra tabela com a quantidade de registros.

Uma solução interessante e que pode ser util.

Tenho aqui uma tabela com varios lancamentos de códigos de barras
Neste código utilizando dois recordset's (um full e o outro filtrado) pesquiso a tabela e atualizo um campo quantidade com o numero de registros encontrados do codigo..


Private Sub Atualizar()
'Aqui declaro as variáveis a serem utilizadas no código, os recordset's e o workspace
Dim Db As DAO.Database
Dim Rs As DAO.Recordset
Dim RsFiltro As DAO.Recordset
Dim RsMax As DAO.Recordset
Dim ws As DAO.Workspace
Dim StrSql As String 'Variável para receber a Sql total da tabela
Dim StrSqlFiltro As String 'Variável para receber a Sql filtrada por um código de barras especifico
Dim CodBarraMax As Double 'Variável para receber o código de barras com o valor maior, o último da tabela. Será necessário para encerrar a sequencia de loop's
Dim StrContador As Double 'Variável que contará o numero de código de barras com o mesmo número
Dim StrBarra As Double 'Variável que recebe o código de barras utilizado no loop, para fazer a atualização bem como para filtrar o segundo recordset

Set ws = DBEngine.Workspaces(0) 'Seto o Workspace
Set Db = ws.OpenDatabase(CurrentProject.Path & "\Leitor_De_Codigo.mdb", False, False, "MS Access;PWD=senha") 'Seto o banco de dados

StrSql = "SELECT * FROM Barras" 'Carrego a variável com a tabela
Set Rs = Db.OpenRecordset(StrSql) 'Seto o recordeset para carregar a variável
CodBarraMax = DMax("CpCodBarras", "Barras") 'Carrego a variável com o Cod de Barras maior na tabela

If Rs.RecordCount = 0 Then 'Se não há registros na tabela
MsgBox "sem registro selecionado", vbInformation, "Atenção"
Else 'Caso contrário carrego a variável StrContador como -1 para dar certo o total de registros existente com um referido código de barras
StrContador = -1


Do While Not Rs.EOF 'Inicio o código para o Loop

StrBarra = Rs!CpCodBarras 'Carrego a variável com o primeiro código de barras do recordeset
StrSqlFiltro = "SELECT * FROM Barras WHERE CpCodBarras = " & StrBarra & "" 'Aqui utilizo um loop dentro de outro, porem carrego o segundo recordser com o filtro especifico ao código de barras carregado na variável SrtBarra, isso é necessário pois fará o loop apenas nos registro do código específico
Set RsFiltro = Db.OpenRecordset(StrSqlFiltro) 'Carrego a outro recordset cja filtrado com o código do primeiro recordset
Do
StrContador = StrContador + 1 'Vai somando o contador para retornar o numero de registo do código de barras
If RsFiltro.EOF Then GoTo Continuar 'Se chegou ao fim para o registro do código contido na variável StrBarra vai para o comando continuar
RsFiltro.MoveNext 'Vai para o próximo registro do recordset filtrado, executando o loop e contando os mesmos
Loop
Continuar: 'Quando o registro do recordset filtrado chegar ao final vai para este comando, consequentemente indo para o próximo código de barras que tem como critério ser maior que o primeiro

Rs.FindFirst "CpCodBarras > " & StrBarra & "" ' Busco no primeiro recordser o proximo código ou seja, um código maior que o que foi utilizado acima
CurrentDb.Execute "UPDATE Codigo SET CpTotalItens= " & StrContador & " WHERE CpCodBarras =" & StrBarra & ";" 'Atualizo a tabela código com a quantidade de registro existentes na tabela barras, atualizando o campo CpTotalItens que é a quantidade de código para este produto existente na tabela Barras
StrContador = -1 'Volto o contador para -1 para iniciar novo loop para o código seguinte que é o imediatamente maior que o anterior

Rs.MoveNext 'Passo ao registro seguinte do primeiro recordset
If StrBarra = CodBarraMax Then 'Aqui é feito a comparação com o registro máximo carregado no início do código, justamente para findar os loop, senão ficaria infinitamente o repetindo, então aqui encerra tudo quando o ultimo código de barras na tabela barras for analisado
MsgBox "Fim da Pesquisa", vbInformation, "Atenção"
Exit Sub
End If
Loop

End If
End Sub

Private Sub btnAtualizar_Click()
Call Atualizar 'Aqui chamo a função no botão.
End Sub

http://dl.dropbox.com/u/26441349/Leitor_de_codigo.rar

Cumprimentos