[Resolvido]Importação de arquivo .xls (Excel) com linhas vazias

Olá a todos,

Preciso importar uma tabela do excel para um outra tabela do access rotineiramente. Para isso estou utilizando o código abaixo, contudo, eventualmente quando da importação de uma tabela do excel com varias linhas de informação para a tabela do access 2010, o código importa linhas sem nenhuma informação. Por exemplo, na hipótese de haver 150 linhas de informação na tabela do excel, o access 2010 importar as 150 linhas com a informação correta, mas acrescenta mais 50 que estão vazias. Preciso limitar a importação da informação somente as células da tabela do excel preenchida com informações. Alguém tem alguma sugestão? Desde já fico grato.

Função utilizada para importação da informação.

Código:



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 = "tblNotaFiscalProdutos"
     
             
        '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



Isso acontece pq essas linhas tinham alguma coisa, ou o usuário editou algo nelas...

Ja considerou a ideia de apos a importação, vc rodar um DELETE * FROM tbAccess WHERE NZ(Len(NomeCampo),0)=0

Assim, ao fim da importação ele apaga as linhas que nao tenha nada... isso contando caracteres de um campo para saber se tem algo la...

Olá Fabio,

Modifiquei o código como o orientado. Peço a gentileza de verificar se o segui a sua orientação da maneira correta.

Código:



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 = "tblNotaFiscalProdutos"
       
             
        'importa para tabela local temporária
        DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, strTable, strPathFile, blnHasFieldNames
        strTable = "DELETE * FROM tblNotaFiscalProdutos WHERE NZ(Len(IdProdutos),0)=0"

        '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



Grato,

Mude esta Linha: strTable = "DELETE * FROM tblNotaFiscalProdutos WHERE NZ(Len(IdProdutos),0)=0"

Para:
CurrentDb.Execute "DELETE * FROM tblNotaFiscalProdutos WHERE NZ(Len(IdProdutos),0)=0"


Obs: Apos a Importação dos dados para a Tabela tblNotaFiscalProdutos Será excluído os registros em que o Campo IdProdutos não tiver nenhum valor... (0 será considerado e o registro não será excluído ta)

NZ(Len(IdProdutos),0)=0 ==> Aqui será feito uma Contagem de caracteres do Campo IdProdutos, e caso esteja NULO ou "" , então irá ser excluído.

Olá Fabio,

Funcionou perfeitamente. Entretanto, ao importar a tabela sempre aparece uma mensagem. Coloquei no link abaixo a mensagem através de um pequeno vídeo. É possível retirar a mensagem? Se não houver a possibilidade não há problema, o importante é esta funcionando.

https://1drv.ms/f/s!AgHCWa12NNUWgct_-_bBSBBDdjm8tQ


Grato,

Sempre podemos Ignorar alguns erros... Basta para isso colocar uma condição para o Codigo do Erro.

Mas eu lhe pergunto:
***Ali ele fala sobre violação de chave ou do campo da tabela esta Menor que os dados do Excel e nao aceitar a quantidade de Caracteres... Ja verificou qual é o Campo para tentar adequar na tabela?

***Mesmo com o erro, todos os Dados são importados?

Olá Fabio,

Mesmo com o erro todos os dados são importados. Fiz alguns testes e importou todas as vezes. Amanhã vou submeter na empresa do cliente há varias importações da tabela com usuários diferente e terei o diagnostico em definitivo. Será que se desabilitar a exibição das mensagens na central de confiabilidade do access funcionará?

Não funcionará nao amigo... Mas faça o seguinte:


No FInal do seu Codigo:
Else
MsgBox Err.Description
End If
Resume PROC_EXIT

End Function


Mude para:

Else
MsgBox Err.Number & " - " & Err.Description
End If
Resume PROC_EXIT

End Function

Assim ele além de emitir ao usuario a Mensagem do erro (como ja esta fazendo) emitirá o Numero do Erro... Então, basta ignora-lo.

Olá Fabio,

Obrigado amigo mais uma vez, pelo seu tempo e ajuda. Funcionou perfeitamente. Através da sua última orientação a mensagem desapareceu.

Grato,

Bacana amigo, Até a próxima se Deus quiser!