Prezado, boa noite,
Você havia me ajudado com o código abaixo, no qual eu selecionava registro por registro da caixa de combinação e clicava em um botão de comando para inserir os dados na tabela comparativo.
Pergunto, é possível eu executar essa comparação de maneira automática sem precisar selecionar o registro na combo cboenviados?
Dim rsEnviados As DAO.Recordset
Dim rsComparativo As DAO.Recordset
Dim StrSQLRec As String
Dim nCount As Long
'-------------------------------------------------------------------------------------------------------------
'Carrego a variável com a SQL da tabela recebidos filtrados pelo campo senhaAutorizaao tendo
'como critério o valor selecionado na cboEnviados. A cboEnviados por sua vez é baseada na tabela Enviados
'Assim o reccordset baseado na tabela recebidos conterá apenas os registros cuja guia esteja na tabela enviados
'---------------------------------------------------------------------------------------------------------------
StrSQLRec = "SELECT * FROM Recebido WHERE senhaAutorizacao = '" & Me.cboEnviados & "'"
'--------------------------------------
'Seto o recordset com a sql da consulta
'--------------------------------------
Set rsRecebidos = CurrentDb.OpenRecordset(StrSQLRec)
'------------------------------------------------------------------
'Movo o ponteiro do recordset para o final em seguida para o início
'------------------------------------------------------------------
rsRecebidos.MoveLast: rsRecebidos.MoveFirst
'-------------------------------------------------------------------------------------
'Caso retorne 1 ou mais regisros seta o recordset baseado na tabela comparativo
'executo loop pelo recordset basado na tabela Recebidos, adicionando um novo registro
'na tabela comparativo. Observe que fiz apenas para dois campo, siga a mesma
'lógica para os demais
'-------------------------------------------------------------------------------------
If rsRecebidos.RecordCount > 0 Then
Set rsComparativo = CurrentDb.OpenRecordset("Comparativo")
Do While Not rsRecebidos.EOF
With rsComparativo
.AddNew
'
!NomeUsuário = rsRecebidos!nomeBeneficiario 'Enviado
'
!CódUsuário = rsRecebidos!numeroCarteira 'Enviado
'
!CódGuia = rsRecebidos!senhaAutorizacao 'Enviado
'
!DtAtendimento = rsRecebidos!dataHoraInternacao 'Enviado
'
!DtAlta = DLookup("DtAlta", "Enviado", "CódGuia = '" & rsRecebidos!senhaAutorizacao & "'") 'Enviado
'
!CódServiço = rsRecebidos!codigo 'Enviado
'
!NomeServiço = rsRecebidos!descricao 'Enviado
'
!QuantidadeEnviado = DLookup("QuantidadeServiço", "Enviado", "CódGuia = '" & rsRecebidos!senhaAutorizacao & "'") 'Enviado
'
!UnitarioEnviado = DLookup("Referencia", "Enviado", "CódGuia = '" & rsRecebidos!senhaAutorizacao & "'") 'Enviado
'
!valorTotalEnviado = DLookup("ValorPago", "Enviado", "CódGuia = '" & rsRecebidos!senhaAutorizacao & "'") 'Enviado
'
!QtdRecebido = rsRecebidos!quantidade 'Recebido
'
!valorUnitario = rsRecebidos!valorUnitario 'Recebido
'
!valorTotalRecebido = rsRecebidos!valorTotal 'Recebido
'
!Nota = DLookup("Nota", "Enviado", "CódGuia = '" & rsRecebidos!senhaAutorizacao & "'") 'Enviado
'
!Fechamento = DLookup("Fechamento", "Enviado", "CódGuia = '" & rsRecebidos!senhaAutorizacao & "'") 'Enviado
.Update
End With
'----------------------------------------------------------------
'Incremento o contador para exibir mensagem de registros copiados
'----------------------------------------------------------------
nCount = nCount + 1
rsRecebidos.MoveNext
Loop
'------------------------------------
'Deleta os arquivos da tabela Enviado
'------------------------------------
CurrentDb.Execute "DELETE * FROM Enviado WHERE CódGuia = '" & Me.cboEnviados & "'"
'Deleta os arquivos da tabela Recebido
'------------------------------------
CurrentDb.Execute "DELETE * FROM Recebido WHERE senhaAutorizacao = '" & Me.cboEnviados & "'"
'---------------------------
'Emite mensagem de terminado
'---------------------------
MsgBox "A consulta localizou e enviou para tabela Comparativo. " & nCount & " Registro(s)", vbInformation, "COMPARANDO DADOS..."
End If
End Sub
Início
XPTOS 21/1/2014, 19:58