[Resolvido]Importar registro via VBA.

Prezados, boa tarde,

Crédito do código ao Harysonh!!!

Estou adaptando o código abaixo para usao em meu sistema de gestão de pagamentos, ou seja, quando eu selecionar um registro na caixa de combinação do formulário o código faz um comparativo de registros semelhantes e envia para tblComparativo.

Minha dúvida é a seguinte: É possível fazer o grifo em vermelho importar para outra tabela somente os dados selecionados na combox?

obs: Isso é feito após a comparação dos registros semelhantes.

----------------------------------------
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 recordset 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 registros seta o recordset baseado na tabela comparativo
'executo loop pelo recordset baseado 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
'
!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
'------------------------------------
CurrentDb.Execute "INSERT INTO EnviadoConf ( NomeUsuário, CódUsuário, CódGuia, DtAtendimento, DtAlta, CódServiço, NomeServiço, QuantidadeServiço, Referencia, ValorPago, Fechamento, Nota )" & vbCrLf & _
"SELECT Enviado.NomeUsuário, Enviado.CódUsuário, Enviado.CódGuia, Enviado.DtAtendimento, Enviado.DtAlta, Enviado.CódServiço, Enviado.NomeServiço, Sum(Enviado.QuantidadeServiço) AS SomaDeQuantidadeServiço, Enviado.Referencia, Sum(Enviado.ValorPago) AS SomaDeValorPago, Enviado.Fechamento, Enviado.Nota" & vbCrLf & _
"FROM Enviado" & vbCrLf & _
"GROUP BY Enviado.NomeUsuário, Enviado.CódUsuário, Enviado.CódGuia, Enviado.DtAtendimento, Enviado.DtAlta, Enviado.CódServiço, Enviado.NomeServiço, Enviado.Referencia, Enviado.Fechamento, Enviado.Nota;"

'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

A consulta deve conter uma cláusula WHERE para filtrar os dados que deseja..

Cumprimentos.

a cláusula eu já tenho, seria: "SELECT * FROM Enviado WHERE CódGuia = '" & Me.cboEnviados & "'"
Agora aonde devo encaixar ela nesse código:
CurrentDb.Execute "INSERT INTO EnviadoConf ( NomeUsuário, CódUsuário, CódGuia, DtAtendimento, DtAlta, CódServiço, NomeServiço, QuantidadeServiço, Referencia, ValorPago, Fechamento, Nota )" & vbCrLf & _
"SELECT Enviado.NomeUsuário, Enviado.CódUsuário, Enviado.CódGuia, Enviado.DtAtendimento, Enviado.DtAlta, Enviado.CódServiço, Enviado.NomeServiço, Sum(Enviado.QuantidadeServiço) AS SomaDeQuantidadeServiço, Enviado.Referencia, Sum(Enviado.ValorPago) AS SomaDeValorPago, Enviado.Fechamento, Enviado.Nota" & vbCrLf & _
"FROM Enviado" & vbCrLf & _
"GROUP BY Enviado.NomeUsuário, Enviado.CódUsuário, Enviado.CódGuia, Enviado.DtAtendimento, Enviado.DtAlta, Enviado.CódServiço, Enviado.NomeServiço, Enviado.Referencia, Enviado.Fechamento, Enviado.Nota;"


Tentei aplicar e deu erro de sintaxe.

Grato,

Coloque esta consulta em uma consulta grafica, abra em modo design, coloque o critério em critérios depois veja o VBA da mesma.

Cumprimentos.

Fiz como orientou e ficou assim:

CurrentDb.Execute "INSERT INTO EnviadoConf ( NomeUsuário, CódUsuário, CódGuia, DtAtendimento, DtAlta, CódServiço, NomeServiço, QuantidadeServiço, Referencia, ValorPago, Fechamento, Nota )" & vbCrLf & _
"SELECT * FROM Enviado WHERE CódGuia = '" & Me.cboEnviados & "'" & vbCrLf & _
"FROM Enviado" & vbCrLf & _
"GROUP BY Enviado.NomeUsuário, Enviado.CódUsuário, Enviado.CódGuia, Enviado.DtAtendimento, Enviado.DtAlta, Enviado.CódServiço, Enviado.NomeServiço, Enviado.Referencia, Enviado.Fechamento, Enviado.Nota;"


Porém, ainda aparece mensagem de erro 3075 - Erro de sintaxe, operador faltando.

Pitaco;

Esta linha está a mais;

"FROM Enviado" & vbCrLf & _

Agradeço a sugestão!

Deu o erro 3121: Não é possível agrupar campos com '*' asterisco.

Caso queira, posso posta o BD.

Poste-o

Cumprimentos.

Segue!

No Form_Itens enviados eu seleciono o registro na combox cboenviado e ao clicar no btnExecutar que está dando esse erro.

https://www.dropbox.com/s/yca9s431ashnt0c/SAC%20-%20Sistema%20de%20An%C3%A1lise%20de%20Contas%2020071.rar

Executar Guia?

Cumprimentos.

btnExecutar que está marcado em azul no form.

O que está escrito no caption deste botão?


Cumprimentos.

Caption está escrito como btnExecutar no formulário (Form_Itens enviados)

Eu poderia abrir o form em modo design e ver o nome do botão..
Mas eu perguntei: O que está escrito no botão?

Cumprimentos.

Sim, me equivoquei!

No botão está escrito Executar Guia.

Atenciosamente,

Basicamente é como está ai abaixo, deves especificar os nomes dos campos quando utiliza uma consulta agrupada..
Este código ao colocar em teu projeto dará erro.. pois a quantidade de campos que agrupo não condiz com a quantidade de campos que vão receber os dados.

Verifique e corrija isto.

Cumprimentos.


CurrentDb.Execute "INSERT INTO EnviadoConf ( NomeUsuário, CódUsuário, CódGuia, DtAtendimento, DtAlta, CódServiço, NomeServiço, QuantidadeServiço, Referencia, ValorPago, Fechamento, Nota )" & vbCrLf & _
"SELECT Enviado.NomeUsuário, Enviado.CódUsuário, Enviado.CódGuia, Enviado.DtAtendimento, Enviado.DtAlta, Enviado.CódServiço, Enviado.NomeServiço, Enviado.Referencia, Enviado.Fechamento, Enviado.Nota FROM Enviado WHERE CódGuia = '" & Me.cboEnviados & "'" & vbCrLf & _
"GROUP BY Enviado.NomeUsuário, Enviado.CódUsuário, Enviado.CódGuia, Enviado.DtAtendimento, Enviado.DtAlta, Enviado.CódServiço, Enviado.NomeServiço, Enviado.Referencia, Enviado.Fechamento, Enviado.Nota;"

Harysohn, bom dia,

Muito obrigado pelas valiosas dicas.

Conseguir acertar o código e ficou assim depois de resolvido:

CurrentDb.Execute "INSERT INTO EnviadoConf ( NomeUsuário, CódUsuário, CódGuia, DtAtendimento, DtAlta, CódServiço, NomeServiço, QuantidadeServiço, Referencia, ValorPago, Fechamento, Nota )" & vbCrLf & _
"SELECT Enviado.NomeUsuário, Enviado.CódUsuário, Enviado.CódGuia, Enviado.DtAtendimento, Enviado.DtAlta, Enviado.CódServiço, Enviado.NomeServiço, Sum(Enviado.QuantidadeServiço) AS SomaDeQuantidadeServiço, Enviado.Referencia, Sum(Enviado.ValorPago) AS SomaDeValorPago, Enviado.Fechamento, Enviado.Nota" & vbCrLf & _
"FROM Enviado WHERE CódGuia = '" & Me.cboEnviados & "'" & vbCrLf & _
"GROUP BY Enviado.NomeUsuário, Enviado.CódUsuário, Enviado.CódGuia, Enviado.DtAtendimento, Enviado.DtAlta, Enviado.CódServiço, Enviado.NomeServiço, Enviado.Referencia, Enviado.Fechamento, Enviado.Nota;"


Grato,

O Fórum agradece o retorno.