[Resolvido]Importar arquivo TXT com 30 linhas por registo

Olá, em cima do joelho acho que está o que pretende.
Veja código, utilizado:

Código:

Sub importarTxt()
'ahteixeira 2016 - maximoaccess
Dim strLinha As String
Dim linha, nRegisto As Double

Dim Empresa, CNPJ, ReferenteMes, CodigoEmp, NomeEmp, ADM, CTPS, PIS, CFP, Funcao, CI
Dim CodMov, DescMov, NoDias, Abono, Desconto
Dim TotAbono, TotDesconto, ValorPago, ValorFinal1, ValorFinal2, ValorFinal3, ValorFinal4, ValorFinal5

    'inicia contador de registos a importar
    nRegisto = 1
    ' se pretender fazer arquivo na linha acima atribua o último da tabela + 1
    ' e retire ou comente as duas linhas abaixo
    
    'apaga tabelas que vao receber os dados
    DoCmd.RunSQL "DELETE * FROM tbl_Movimento"
    DoCmd.RunSQL "DELETE * FROM tbl_MovimentoDetalhe"
    
    'ficheiro a ler para importar
    Open Application.CurrentProject.Path & "\teste.txt" For Input As #1
    
    'inicio leitura do txt linha a linha
    Do Until EOF(1)
        linha = linha + 1
        Line Input #1, strLinha
        
        'processa campos que estao na linha 1
        If linha = 1 Then
            Empresa = Trim(Mid(strLinha, 1, 5))
        End If
        
        If linha = 3 Then
            CNPJ = Mid(strLinha, 14, 18)
            ReferenteMes = Right(strLinha, Len(strLinha) - (InStr(strLinha, "Referente ao mês de") + 19))
        End If
        
        If linha = 5 Then
            CodigoEmp = Trim(Left(strLinha, 10))
            NomeEmp = Trim(Mid(strLinha, 12, 40))
            ADM = Mid(strLinha, 57, 10)
            CTPS = Mid(strLinha, 73, 15)
            PIS = Mid(strLinha, 93, 11)
            CFP = Mid(strLinha, 109, 11)
        End If

        
        If linha = 6 Then
            Funcao = Trim(Mid(strLinha, 60, 42))
            CI = Trim(Mid(strLinha, 106, 10))
        End If
        
        
        'processa da linha 9 até 23 - as 15 linhas do detalhe
        If linha > 8 And linha < 24 And Len(strLinha & "") <> 0 Then
        
            'Adiciona registo à tabela Movimento (apenas na linha 9)
            'para se poder lançar registos na tabela MovimentoDetalhe
            'é necessário, por causa das relações, no final é atualizado com o resto da informação
            If linha = 9 Then DoCmd.RunSQL "INSERT INTO tbl_Movimento ( NoRegisto ) SELECT " & nRegisto & ";"

            CodMov = Trim(Mid(strLinha, 1, 9))
            DescMov = Trim(Mid(strLinha, 11, 50))
            NoDias = Trim(Mid(strLinha, 61, 9))
            Abono = Trim(Mid(strLinha, 80, 12))
            Desconto = Trim(Mid(strLinha, 104, 12))
            
            'adiciona ao MovimentoDetalhe
            DoCmd.RunSQL "INSERT INTO tbl_MovimentoDetalhe ( NoRegistoDetalhe, CodMov, DescMov, NoDias, Abono, Desconto ) SELECT " & _
                            nRegisto & "," & CodMov & ",'" & DescMov & "','" & NoDias & "','" & Abono & "','" & Desconto & "';"
        End If
        
        
        If linha = 25 Then
            TotAbono = Trim(Mid(strLinha, 82, 10))
            TotDesconto = Trim(Mid(strLinha, 106, 10))
        End If
        
        
        If linha = 27 Then
            ValorPago = Trim(Mid(strLinha, 106, 10))
        End If
        
        
        If linha = 29 Then
            ValorFinal1 = Trim(Mid(strLinha, 11, 10))
            ValorFinal2 = Trim(Mid(strLinha, 28, 10))
            ValorFinal3 = Trim(Mid(strLinha, 52, 10))
            ValorFinal4 = Trim(Mid(strLinha, 69, 10))
            ValorFinal5 = Trim(Mid(strLinha, 95, 10))
        End If
        
        If linha = 30 Then
            'atualiza dados
            DoCmd.RunSQL "UPDATE (tbl_Movimento) SET Empresa = '" & Empresa & "'," & _
                         "CNPJ = '" & CNPJ & "'," & _
                         "ReferenteMes = '" & ReferenteMes & "'," & _
                         "CodigoEmp = '" & CodigoEmp & "'," & _
                         "NomeEmp = '" & NomeEmp & "'," & _
                         "ADM = '" & ADM & "'," & _
                         "CTPS = '" & CTPS & "'," & _
                         "PIS = '" & PIS & "'," & _
                         "CFP = '" & CFP & "'," & _
                         "Funcao = '" & Funcao & "'," & _
                         "CI = '" & CI & "'," & _
                         "TotAbono = '" & TotAbono & "'," & _
                         "TotDesconto = '" & TotDesconto & "'," & _
                         "ValorPago = '" & ValorPago & "'," & _
                         "ValorFinal1 = '" & ValorFinal1 & "'," & _
                         "ValorFinal2 = '" & ValorFinal2 & "'," & _
                         "ValorFinal3 = '" & ValorFinal3 & "'," & _
                         "ValorFinal4 = '" & ValorFinal4 & "'," & _
                         "ValorFinal5 = '" & ValorFinal5 & "'" & _
                         "WHERE tbl_Movimento.NoRegisto = " & nRegisto & ";"

            'actualiza contadores
            nRegisto = nRegisto + 1
            linha = 0
            
            'limpa campos
            Empresa = ""
            CNPJ = ""
            ReferenteMes = ""
            CodigoEmp = ""
            NomeEmp = ""
            ADM = ""
            CTPS = ""
            PIS = ""
            CFP = ""
            Funcao = ""
            CI = ""
            CodMov = ""
            DescMov = ""
            NoDias = ""
            Abono = ""
            Desconto = ""
            TotAbono = ""
            TotDesconto = ""
            ValorPago = ""
            ValorFinal1 = ""
            ValorFinal2 = ""
            ValorFinal3 = ""
            ValorFinal4 = ""
            ValorFinal5 = ""
        End If
    
    'fim eitura txt
    Loop

    'fechar ficheiro
    Close #1
    
    MsgBox "Feito, Verifique tabelas.", vbInformation, ""
End Sub


Segue o teste.
Nota: Alterei titulo do tópico para ficar mais fácil nas pesquisa para os membros do fórum.
Abraço

Rapaz, essa Galera só nao faz chover com o Access...


Parabéns Ahteixeira Pelo Excelente exemplo... Muito Bom mesmo!

Olá Fábio, obrigado pelo retorno.
Todos sabemos que com o MaximoAccess é sempre aprender.  

Fiz uma pequena alteração no código, funciona tal e qual, mas ficou menos linhas de código.
Mensagem 19 atualizada.

Ficamos aguardar retorno do colega Uilson.
Abraço

Primeiramente gostaria de agradecer a paciência, dedicação e empenho do amigo Alvaro Teixeira na solução desta demanda. Entendo que o material aqui disponível, será um referência e de grande valia para quem necessitar de algo do gênero.

Fiz algumas alterações na estrutura das tabelas e consequentemente no código, por isso estou anexando todo o material.

No arquivo original de importação, notei que a posição dos dados do PIS e CPF, depende do número de caracteres gerados para a CTPS. A solução neste caso, foi retirar os dados encontrados entre duas strings. Para isso utilizei de um exemplo também do amigo Alvaro Teixeira encontrado aqui no fórum: https://www.maximoaccess.com/t20159p3-importando-nota-fiscal-eletronica-xml-para-access.

Vejam:

Código:

Sub ImportTXT()
'ahteixeira 2016 - maximoaccess
Dim strLinha As String
Dim linha, nRegistro As Double

Dim EMPRESA, ENDERECO, CNPJ, REFMES, CODFUNC, NOMEFUNC, ADM, CTPS, PIS, CPF, FUNCAO, CI
Dim CODMOV, DESCMOV, NDIAS, PROVENTOS, DESCONTOS
Dim TOTPROV, TOTDESC, VLRSALDO, BASESAL, BASEINSS, BASEFGTS, VLRFGTS, VLRIRRF

    'inicia contador de registos a importar
    nRegistro = Nz(DMax("NREG", "tblMovimento"), 0) + 1
    
    'ficheiro a ler para importar
    Open txtArquivo For Input As #1
    
    'inicio leitura do txt linha a linha
    Do Until EOF(1)
        linha = linha + 1
        Line Input #1, strLinha
        
        'processa campos que estao na linha 1
        If linha = 1 Then
            EMPRESA = Trim(Mid(strLinha, 1, 60))
        End If
        
        If linha = 2 Then
            ENDERECO = Trim(Mid(strLinha, 1, 60))
        End If
        
        If linha = 3 Then
            CNPJ = Mid(strLinha, 14, 18)
            REFMES = right(strLinha, Len(strLinha) - (InStr(strLinha, "Referente ao mês de") + 19))
        End If
        
        If linha = 5 Then
            CODFUNC = Trim(left(strLinha, 10))
            NOMEFUNC = Trim(Mid(strLinha, 12, 40))
            ADM = Mid(strLinha, 57, 10)
            CTPS = Trim(SeparaEntreDuasStrings(strLinha, "CTPS:", "PIS:"))
            PIS = Trim(SeparaEntreDuasStrings(strLinha, "PIS:", "CPF:"))
            CPF = right(strLinha, Len(strLinha) - (InStr(strLinha, "CPF:") + 3))
        End If

        If linha = 6 Then
            FUNCAO = Trim(Mid(strLinha, 60, 42))
            CI = Trim(Mid(strLinha, 106, 10))
        End If
        
        If linha = 9 Then
            'Adiciona registo à tabela Movimento
            'para se poder lançar registos na tabela MovimentoDetalhe
            'é necessário, por causa das relações, no final é atualizado com o resto da informação
            DoCmd.RunSQL "INSERT INTO tblMovimento ( NREG ) SELECT " & nRegistro & ";"
            '----
            
            CODMOV = Trim(Mid(strLinha, 1, 9))
            DESCMOV = Trim(Mid(strLinha, 11, 50))
            NDIAS = Trim(Mid(strLinha, 61, 9))
            PROVENTOS = Trim(Mid(strLinha, 80, 12))
            DESCONTOS = Trim(Mid(strLinha, 104, 12))

            'adiciona ao MovimentoDetalhe
            DoCmd.RunSQL "INSERT INTO tblMovimentoDetalhe ( NREGD, CODMOV, DESCMOV, NDIAS, PROVENTOS, DESCONTOS ) SELECT " & _
                            nRegistro & "," & CODMOV & ",'" & DESCMOV & "','" & NDIAS & "','" & PROVENTOS & "','" & DESCONTOS & "';"
        End If
        
        'processa da linha 10 até 23 - as 15 linhas do detalhe
        If linha > 9 And linha < 24 And Len(strLinha & "") <> 0 Then
            CODMOV = Trim(Mid(strLinha, 1, 9))
            DESCMOV = Trim(Mid(strLinha, 11, 50))
            NDIAS = Trim(Mid(strLinha, 61, 9))
            PROVENTOS = Trim(Mid(strLinha, 80, 12))
            DESCONTOS = Trim(Mid(strLinha, 104, 12))
            
            'adiciona ao MovimentoDetalhe
            DoCmd.RunSQL "INSERT INTO tblMovimentoDetalhe ( NREGD, CODMOV, DESCMOV, NDIAS, PROVENTOS, DESCONTOS ) SELECT " & _
                            nRegistro & "," & CODMOV & ",'" & DESCMOV & "','" & NDIAS & "','" & PROVENTOS & "','" & DESCONTOS & "';"
        End If
        
        
        If linha = 25 Then
            TOTPROV = Trim(Mid(strLinha, 82, 10))
            TOTDESC = Trim(Mid(strLinha, 106, 10))
        End If
        
        
        If linha = 27 Then
            VLRSALDO = Trim(Mid(strLinha, 106, 10))
        End If
        
        
        If linha = 29 Then
            BASESAL = Trim(Mid(strLinha, 11, 10))
            BASEINSS = Trim(Mid(strLinha, 28, 10))
            BASEFGTS = Trim(Mid(strLinha, 52, 10))
            VLRFGTS = Trim(Mid(strLinha, 69, 10))
            VLRIRRF = Trim(Mid(strLinha, 95, 10))
        End If

        If linha = 30 Then
            'atualiza dados
            DoCmd.RunSQL "UPDATE (tblMovimento) SET Empresa = '" & EMPRESA & "'," & _
                         "ENDERECO = '" & ENDERECO & "'," & _
                         "CNPJ = '" & CNPJ & "'," & _
                         "REFMES = '" & REFMES & "'," & _
                         "CODFUNC = '" & CODFUNC & "'," & _
                         "NOMEFUNC = '" & NOMEFUNC & "'," & _
                         "ADM = '" & ADM & "'," & _
                         "CTPS = '" & CTPS & "'," & _
                         "PIS = '" & PIS & "'," & _
                         "CPF = '" & CPF & "'," & _
                         "Funcao = '" & FUNCAO & "'," & _
                         "CI = '" & CI & "'," & _
                         "TOTPROV = '" & TOTPROV & "'," & _
                         "TOTDESC = '" & TOTDESC & "'," & _
                         "VLRSALDO = '" & VLRSALDO & "'," & _
                         "BASESAL = '" & BASESAL & "'," & _
                         "BASEINSS = '" & BASEINSS & "'," & _
                         "BASEFGTS = '" & BASEFGTS & "'," & _
                         "VLRFGTS = '" & VLRFGTS & "'," & _
                         "VLRIRRF = '" & VLRIRRF & "'" & _
                         "WHERE tblMovimento.NREG = " & nRegistro & ";"
            
            'actualiza contadores
            nRegistro = nRegistro + 1
            linha = 0
            
            'limpa campos
            EMPRESA = ""
            ENDERECO = ""
            CNPJ = ""
            REFMES = ""
            CODFUNC = ""
            NOMEFUNC = ""
            ADM = ""
            CTPS = ""
            PIS = ""
            CPF = ""
            FUNCAO = ""
            CI = ""
            CODMOV = ""
            DESCMOV = ""
            NDIAS = ""
            PROVENTOS = ""
            DESCONTOS = ""
            TOTPROV = ""
            TOTDESC = ""
            VLRSALDO = ""
            BASESAL = ""
            BASEINSS = ""
            BASEFGTS = ""
            VLRFGTS = ""
            VLRIRRF = ""
        End If
    'fim eitura txt
    Loop
    
    'fechar ficheiro
    Close #1
    
    'Elimina arquivo
    If Sel1 = -1 Then
        Kill (txtArquivo)
    End If
    
    'Limpa o campo
    txtArquivo = ""
    
    'Ativa o botão sair
    btSair.Enabled = True
    
    'Exibe Mensagem
    MsgBox "Importação realizada com sucesso.", vbInformation, "Sistema"
End Sub

Retira dados entre duas strings

Código:

'2014 Alvaro Teixeira
Function SeparaEntreDuasStrings(strTotal As String, strInicio As String, strFim As String)
Dim i As Long, j As Long
    i = InStr(strTotal, strInicio)
    j = InStr(strTotal, strFim)
    SeparaEntreDuasStrings = Mid(strTotal, i + Len(strInicio), j - i - Len(strInicio))
End Function

'Botão btImportar

Código:

btFoco.SetFocus
If Nz(Len(txtArquivo), 0) = 0 Then 'Verifica se o arquivo foi selecionado
    MsgBox "É necessário selecionar o arquivo.", vbCritical, "Sistema"
    Call btArquivo_Click
    Exit Sub
ElseIf Nz(Len(Dir(txtArquivo)), 0) = 0 Then 'Verifica se o arquivo existe
    MsgBox "O arquivo selecionado não foi encontrado.", vbCritical, "Sistema"
    Exit Sub
End If
If MsgBox("Confirma a importação dos dados?", vbQuestion + vbYesNo, "Sistema") = vbYes Then
    btImportar.Enabled = False
    btSair.Enabled = False
    Call ImportTXT
End If

Olá Uilson, como vocês dizam aí, ficou show de bola.
Obrigado pelo retorno (e partilha).

Fiz uma pequena edição na sub mensagem 22:

dê:

Código:

'inicia contador de registos a importar
 nRegistro = Nz(DMax("IDCAPA", "tblMovimento"), 0) + 1

para:

Código:

'inicia contador de registos a importar
nRegistro = Nz(DMax("NREG", "tblMovimento"), 0) + 1

Olá Uilson, obrigado pelo retorno.
Os utilizadores do fórum agradecem.
Abraço

Olá Uilson,

Primeiramente, parabéns pelo projeto.

Gostaria de saber se há a possibilidade de criar um projeto basicamente igual ao postado por você, mas para importar arquivos DAF-607 (simples nacional) em uma tabela. A extensão dele não é .txt (é padrão da receita federal).

Att,

Mordomo.

Mordomo, boa tarde!

Creio que sim. Me envie o arquivo para que eu possa verificar melhor.

e-mail: uilsonbrasil@hotmail.com

Aí falamos melhor posteriormente para verificar as necessidades ...

Olá a todos,

A razão do fórum é a partilha do conhecimento e inter-ajuda.
O envio de mensagem privada através de email, priva os restantes membros.

Abraço a todos