Cara,
Sim. Eu cliquei em baixar. Todavia, o que baixou aqui foram os arquivos que eu havia lhe mandado e não os seus arquivos.
Dessa vez, (ufa!) deu certo. Baixei seus arquivos. Todavia, ele não funciona aqui. Qual é a versão do Excel que você está usando? Eu uso a versão 2007.
Todavia, creio que não seja nem preciso eu rodar o seu programa pois você disse que a única coisa que está faltando é você evitar que o cadastro da NF não seja duplicado. Para isso, basta você verificar, antes de gravar no BD, se a NF existe. Veja, naquele meu arquivo enviado, na parte de inserir um novo número de telefone, que eu faço essa verificação (no caso pela Matrícula). Isso já está devidamente tratado lá no exemplo (código abaixo). DETALHE: Veja, que no BD o campo Matrícula não admite gravação duplicada. Ele está configurado como "Sim (Duplicação não autorizada)" no campo Indexado da guia geral da folha no modo Design.
Private Sub Btn_Inserir_Click()
' Cria variável para armazenar comandos SQL
Dim ComandoSQL As String
Dim consulta2 As Recordset
'Se o campo matrícula NÃO estiver em branco...
If Txt_Matricula.Text <> "" Then
'Armazena 3 linhas de comando SQL
ComandoSQL = "select * from Funcionarios"
ComandoSQL = ComandoSQL & " Inner Join Ambientes on Funcionarios.CodAmbiente = Ambientes.CodAmbiente"
'ComandoSQL = ComandoSQL & " where Matrícula like '" & Txt_Matricula.Text & "'"
'Cgama a rotina que faz a conexão com o BD
Call Conecta
'Atribui a variável de Objeto de BD a execução dos comandos SQL
Set consulta = banco.OpenRecordset(ComandoSQL)
'Enquanto consulta (variável objeto do BD)...
With consulta
'Abre o Recordset do BD para inserção
.AddNew
'Armazena em cada um dos campos do BD (tabela Funcionarios) os valores constantes nas caixas de texto e combo do formulário
.Fields("Matrícula") = Txt_Matricula.Text
.Fields("Nome") = Txt_Nome.Text
.Fields("Ramal") = Txt_Telefone.Text
.Fields("Funcionarios.CodAmbiente") = Cmb_Codigo.Value
'Se houver erro de acesso aos dados (matrícula já cadastrada), desvia para o rótulo Sai
On Error GoTo Sai:
'Efetiva a atualização do BD
.Update
End With
'Fecha o Recorset e a conexão com o BD
consulta.Close
banco.Close
'Chama a rotina que desconecta do BD (libera variáveis objeto de BD)
Call Desconecta
'Exibe mensagem de sucesso na inclusão do registro
MsgBox "Dados Inseridos com Sucesso!", vbDefaultButton1, "INSERÇÃO"
' 'Limpa todos os campos para permitir novas inserções
' Txt_Matricula.Text = ""
' Txt_Nome.Text = ""
' Txt_Telefone.Text = ""
' Cmb_Codigo.Value = ""
' Lbl_Local.Caption = ""
'
' 'Devolve o cursor para o campo Matrícula
' Txt_Matricula.SetFocus
Call Conecta
Frm_Consulta.Cmb_Nome.Clear
Set consulta2 = banco.OpenRecordset("select Nome from Funcionarios order by Nome;")
'Laço para preencher o combo nome na inicialização do form, enquanto _
não chegar o final do arquivo (Tabela Funcionarios)
Do Until consulta2.EOF
'Adiciona o valor atual da consulta ao combo
Frm_Consulta.Cmb_Nome.AddItem consulta2![Nome]
'Move o ponteiro dentro do BD para o próximo registro
consulta2.MoveNext
Loop
Set consulta2 = Nothing
Call Desconecta
Unload Me
Exit Sub
Else 'Se campo Matrícula estiver em Branco...
'Exibe mensagem ao usuário para que aceite matrícula automática
MsgBox "O Campo Matrícula não pode ficar em branco e nem deve conter valores duplicados. Caso não haja matrícula, basta aceitar a matrícula automática.", vbCritical, "INSERÇÃO"
'Devolve o cursor para o campo Matrícula
Txt_Matricula.SetFocus
Exit Sub
End If
Sai: 'Se houver erro de acesso aos dados (Matrícula já cadastrada), o processamento é desviado para cá
If Err.Number = 3022 Then
'Exibe mensagem ao usuário que está tentando inserir uma matrícula já cadastrada
MsgBox "Esta matrícula já está cadastrada!", vbCritical, "INSERÇÂO"
'Limpa todos os campos para permitir novas inserções
Txt_Matricula.Text = ""
Txt_Nome.Text = ""
Txt_Telefone.Text = ""
Cmb_Codigo.Value = ""
Lbl_Local.Caption = ""
'Chama a rotina que desconecta do BD (libera variáveis objeto de BD)
Call Desconecta
'Abandona a subrotina
Exit Sub
Else 'Qualquer outro tipo de Erro
'Limpa todos os campos para permitir novas inserções
MsgBox "Ocorreu o erro De número " & Err.Number & " - " & Err.Description & ". Contate com o Desenvolvedor e informe essa ocorrência.", vbCritical, "INSERÇÃO"
'Limpa todos os campos para permitir novas inserções
Txt_Matricula.Text = ""
Txt_Nome.Text = ""
Txt_Telefone.Text = ""
Cmb_Codigo.Value = ""
Lbl_Local.Caption = ""
'Chama a rotina que desconecta do BD (libera variáveis objeto de BD)
Call Desconecta
'Abandona a subrotina
Exit Sub
End If
End Sub
Desenvolvo pequenas soluções em VBA Excel a valores que variam entre R$ 50,00 a R$ 200,00. Se te interessar, entre no meu instagran (vba_excel_desenvolvimento)
Atenciosamente
Wagner Morel
Postado : 03/06/2018 1:45 pm