[Resolvido]Desabilitar o botão de importação depois da importação de um arquivo do excel para a base de dados do access

Boa tarde Gente,

Estou com o seguinte problema. Tenho um formulário chamado "frm_notafiscal". Nele possui um botão chamado "btn_importarprodutos". O código funciona com perfeição. Entretanto, o que preciso, é que no momento em que o usuário tentar importar pela segunda vez, não lhe seja permitido uma nova  importação. Na prática se ele tentar buscar um segundo arquivo o código não permitirá uma nova importação para a tabela do access 2010. A extensão do arquivo importado esta no formato xlsx. (Excel). Abaixo estou postando o código que estou usando, mas não tenho obtido sucesso, pois não consigo bloquear a função. Ressalto que a o campo da tabela "notafiscal" abaixo indicado não é o que contém a chave primaria na tabela "tbl_notafiscal_produtos". Preciso bloquear por esta linha, haja vista, nela consta o "Id" da tabela nota fiscal. Grato a todos pela ajuda e dica.

Código:



If DCount("*", "tbl_notafiscal_produtos", "notafiscal<>" & txt_id )  Then

 Else
   MsgBox "Não é possível importar produtos mais de uma vez", vbInformation, ""
   Exit Sub
    End If



Código:



 Private Sub btn_importarprodutos_Click()
If DCount("*", "tbl_notafiscal_produtos", "notafiscal<>" & txt_id )  Then
  
'Habilite a Referencia VBA Microsoft Office 12.0 object library (Ms Access 2007)
'Ou Microsoft Office 11.0 object library (Ms Access 2003)
Dim strPathFile As String, strFile As String, strPath As String
Dim strTable As String
Dim CaminhoDoFicheiro As String
Dim JanelaDeProcura As Office.FileDialog
Dim MeusFiltros As Office.FileDialogFilter


Dim blnHasFieldNames As Boolean
blnHasFieldNames = True
strPath = "C:\Gestor\importacao\" ' drive onde se situa o seu documento excel
strTable = "tbl_notafiscal_produtos" 'nome da tabela no seu banco

Set JanelaDeProcura = Application.FileDialog(msoFileDialogFilePicker)

With JanelaDeProcura
.Title = "Selecione a Imagem"
.Filters.Clear
.Filters.Add "Excel Files", "*.xlsx"

.FilterIndex = 2

.ButtonName = "Selecione"
.InitialView = msoFileDialogViewDetails
.InitialFileName = "C:\Gestor\importacao\"
If .Show = -1 Then
CaminhoDoFicheiro = CStr(JanelaDeProcura.SelectedItems.Item(1))
Else
Exit Sub
End If
Debug.Print Mid([CaminhoDoFicheiro], InStrRev([CaminhoDoFicheiro], "\") + 1)
CaminhoDoFicheiro = Mid([CaminhoDoFicheiro], InStrRev([CaminhoDoFicheiro], "\") + 1)
End With

strFile = Dir(strPath & CaminhoDoFicheiro) 'preciso que aqui tenha uma opção para procurar o arquivo, com "*.xls" ele carrega todos, e eu quero que ele defina o selecionado.

Do While Len(strFile) > 0
strPathFile = strPath & strFile
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, _
strTable, strPathFile, blnHasFieldNames
strFile = Dir()
Loop
MsgBox "Importação efectuada com sucesso...", vbInformation

 Else
   MsgBox "Não é possível importar produtos mais de uma vez", vbInformation, ""
   Exit Sub
    End If
End Sub




Boa noite Gente,


Tenho tentado mas não consegui ainda. Se alguém ajudar-me com uma dica ou exemplo agradeço imensamente.

Olá, veja se tópico abaixo ajuda:
https://www.maximoaccess.com/t19615p6-resolvidoatualizacao-automatica-na-importacao-access-excel
Abraço

Olá Teixeira,

Estou estudando o código, assim que terminar já informo o resultado.

Olá, o tópico que fiz referência é do tipo "sincronização".
Caso não se aplique (parece que pretende importar mais que um ficheiro de uma só vez).
Poste 2 ou 3 ficheiros de excel para se poder testar o seu código e base de dados com a tabela que vai receber os dados.
E explique melhor o que está acontecer e o que pretende.
Abraço

Nota: O titulo do tópico parece desajustado à questão, p.f. rectifique.

Boa tarde Teixeira,

Primeiro gostaria de agradecer mais uma vez. Através de sua dica através do link https://www.maximoaccess.com/t19615p6-resolvidoatualizacao-automatica-na-importacao-access-excel, troquei o meu código pelo o indicado e ficou muito melhor, realizei algumas adaptações, mas esta mais profissional. Contudo na questão inicial não consegui resolver. Veja, o que preciso é que o usuário importe somente uma vez a tabela do excel para o banco do access quando o campo "notafiscal" de ambos forem identicos. Na prática, quando o usuário clicar novamente no botão de importação do formulário e houver no campo "notafiscal" da planilha e no campo "notafiscal" da tabela do access o mesmo valor, a função bloqueia a opção, não permitindo uma nova importação. No código que tu me indicastes ele apaga os dados existentes na tabela no access, adaptei o código retirando esta opção e ficou excelente. Mas o usuário continua importando mais de uma vez os mesmos dados para a tabela. Após a adaptação usei a função DCount para quando o usuário clicar uma segunda vez no botão de importação do formulário, a função verificará se na tabela do access "tbl_notafiscal_produtos" no campo "notafiscal" já existe o mesmo valor da tabela, se houver exiba a mensagem "Não é possível importar a mesma Nota Fiscal mais de uma vez". Entretanto não deu certo, pois permite a importação mais de uma vez.

Código:


Private Sub btn_importarprodutos_Click()
    If DCount("*", "tbl_notafiscal_produtos", "notafiscal<>" & txt_id) Then
       Call AbrirRC
       Else
   MsgBox "Não é possível importar a mesma Nota Fiscal mais de uma vez", vbInformation, ""
   Exit Sub
    End If

End Sub


Function AbrirRC() As String
    
    ' Requer referencia a Microsoft Office 11 Object Library
    On Error GoTo PROC_ERR
    
    Dim fd As FileDialog
    Set fd = Application.FileDialog(msoFileDialogFilePicker)
    
    fd.Title = "selecione o ficheiro"
    fd.Filters.Add "Ficheiro XLS", "*.xls", 1

    fd.Show
    
    If (fd.SelectedItems.Count > 0) Then
        '------inicio importação excel para sincronização
        Dim strPathFile As String, strFile As String, strPath As String
        Dim strTable As String
        Dim blnHasFieldNames As Boolean
        blnHasFieldNames = True
        strPathFile = fd.SelectedItems(1)
        strTable = "tbl_notafiscal_produtos"
      
              
        'importa para tabela local temporária
        DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, strTable, strPathFile, blnHasFieldNames
        'sql verifica existentes e marca com não novo
       ' DoCmd.OpenQuery "xls01marcaExistentes", acViewNormal, acEdit
        'sql atualiza existentes
       ' DoCmd.OpenQuery "xls02AtualizaExistentes", acViewNormal, acEdit
        'sql lança novos no ficheiro funcionarios
       ' DoCmd.OpenQuery "xls03LancaNovos", acViewNormal, acEdit
        
        MsgBox "Operação concluída.", vbInformation, ""
        
        
    Else
        MsgBox "Não foi escolhido nenhum ficheiro", vbInformation, ""
    End If
    
PROC_EXIT:
    Exit Function
    
PROC_ERR:
    DoCmd.Hourglass False
    If Err.Number = 3011 Then
       LocalXML = ""
       MsgBox ("Ficheiro inválido.")
    Else
        MsgBox Err.Description
    End If
    Resume PROC_EXIT
    
End Function


Olá,

Tentei a função abaixo e também não deu certo. Se houver alguma dica ou indicação, agradeço a todos que possam ajudar.

Código:


Private Sub btn_importarprodutos_Click()
    If  Not IsNull(DLookup("[notafiscal]", "tbl_notafiscal_produtos", "notafiscal<>" & Me!txt_id))Then
      Call AbrirRC
      Else
  MsgBox "Produtos já importados", vbInformation, ""
  Exit Sub
    End If

End Sub


Function AbrirRC() As String
   
    ' Requer referencia a Microsoft Office 11 Object Library
    On Error GoTo PROC_ERR
   
    Dim fd As FileDialog
    Set fd = Application.FileDialog(msoFileDialogFilePicker)
   
    fd.Title = "selecione o ficheiro"
    fd.Filters.Add "Ficheiro XLS", "*.xls", 1

    fd.Show
   
    If (fd.SelectedItems.Count > 0) Then
        '------inicio importação excel para sincronização
        Dim strPathFile As String, strFile As String, strPath As String
        Dim strTable As String
        Dim blnHasFieldNames As Boolean
        blnHasFieldNames = True
        strPathFile = fd.SelectedItems(1)
        strTable = "tbl_notafiscal_produtos"
     
             
        'importa para tabela local temporária
        DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, strTable, strPathFile, blnHasFieldNames
        'sql verifica existentes e marca com não novo
      ' DoCmd.OpenQuery "xls01marcaExistentes", acViewNormal, acEdit
        'sql atualiza existentes
      ' DoCmd.OpenQuery "xls02AtualizaExistentes", acViewNormal, acEdit
        'sql lança novos no ficheiro funcionarios
      ' DoCmd.OpenQuery "xls03LancaNovos", acViewNormal, acEdit
       
        MsgBox "Operação concluída.", vbInformation, ""
       
       
    Else
        MsgBox "Não foi escolhido nenhum ficheiro", vbInformation, ""
    End If
   
PROC_EXIT:
    Exit Function
   
PROC_ERR:
    DoCmd.Hourglass False
    If Err.Number = 3011 Then
      LocalXML = ""
      MsgBox ("Ficheiro inválido.")
    Else
        MsgBox Err.Description
    End If
    Resume PROC_EXIT
   
End Function



Olá, não temos como verificar qual o valor de Me!txt_id, verifique bem qual o valor.
Pode tentar assim:

Código:

If DCount("*", "tbl_notafiscal_produtos", "notafiscal<>" & Val(txt_id)) Then

Entretanto estou a ver alternativa, importar para tabela temporaria.
Depois verifica se já existe na tabela destino, poderá ser solução.
Abraço

Olá Teixeira,

Tentei a solução proposta, contudo não foi bem sucedida. Abaixo consta o link com o banco de dados. Não consegui resolver o problema até agora. Se houver alguem com uma sugestão eu agradeço.

https://1drv.ms/f/s!AgHCWa12NNUWvSAiFwYI4Vpch5E8

Olá, com o anexo foi mais fácil compreender.
Veja se é o que pretende:

Código:

Private Sub btn_importarprodutos_Click()
    If DCount("*", "tbl_notafiscal_produtos", "notafiscal=" & Me.txt_id) = 0 Then
        Call AbrirRC
    Else
        MsgBox "Produtos já importados", vbInformation, ""
    End If
End Sub

Abraço

Bom dia Teixeira,

Primeiro agradeço seu tempo e boa vontade. O problema foi parcialmente resolvido. Apliquei a modificação no código no "btn_importarprodutos", contudo após a importação do produto o usuário deve executar o botão "btn_precoVenda". Ele esta vinculado a consulta "cst_notafiscal_margemContribuicao", onde ao executar o botão a consulta adiciona os dados na tabela "tbl_notafiscal_precoVenda". Coloco esta nova situação porque tanto a importação dos produtos, já solucionado anteriormente, quanto nesta nova situação o usuário somente poderá executar uma única vez o "btn_precoVenda". Para isso usei o código que você gentilmente me cedeu, mas agora ao tentar executar a consulta, "cst_notafiscal_margemContribuicao" ,3 erros são apontados e não é enviado os dados para a tabela corretamente. Abaixo consta os erros e link para download com o banco e um vídeo onde mostro mais claramente o que esta acontecendo. Amigo peço desculpas pelo abuso, contudo não sou profissional na area e tenho estudado bastante, mas me falta um curso mais focado, pois aonde resido não temos profissionais ou professores especializados no access ou vba. Agradeço imensamente sua ajuda.

1. Erro 1:



2. Erro 2:



3. Erro 3:



Link para download do banco e vídeo: https://1drv.ms/f/s!AgHCWa12NNUWvSAiFwYI4Vpch5E8

Olá Teixeira,

Coloquei as imagens dentro do link abaixo, juntamente com um vídeo e o banco

https://1drv.ms/f/s!AgHCWa12NNUWvSAiFwYI4Vpch5E8


Grato,

Olá Darlan, acabei de verificar, acho que tem haver com a relação do IdProdutos da tabela que vai receber os dados.
Efetue um backup e elimine a relação assinalada abaixo para testar:


Caso não tenha problemas, já sabe onde tem que corrigir.
Sou da opinião que logo de seguida a importar, deveria fazer a consulta, ficava resolvido de uma só vez (não sei se é possivel operacionalmente).
Abraço

Olá Teixeira,

Identifiquei o erro no relacionamento da tabela. Aparentemente foi resolvido. Teixeira nunca imaginei que fosse tão complexo e desafiador. Testei e deu certo, mas agora vou testar com o cliente e verificar se com o uso, o problema foi realmente resolvido, submetendo o aplicativo ao usuário. Fico imensamente grato pela sua consultoria, tomei tanto o teu tempo que mais parece uma consultoria. Agradeço imensamente a ajuda. Continuarei a testar e postarei oportunamente algum problema se acontecer novamente.


Grato,

Olá Darlan, que bom que idtificou o erro e resolveu.
Obrigado pelo retorno.
Esta é a razão do fórum, sempre dentro da nossa disponibilidade a inter-ajuda e partilha do conhecimento.
Isto é ser MaximoAccess.
Abraço