Importar .txt - Arquivos com Lay out diferente

Amigos, boa tarde!

Adaptei em meu projeto uma grande solução feita pelo HARYSOHN - PILOTO
http://maximoaccess.forumeiros.com/t16443-resolvidoimportacao-de-texto?highlight=importa%C3%A7%C3%A3o. Que atende perfeitamente a necessidade de arquivos .txt que possuem um lay out padrão.

Gostaria de saber se é possível, importar dados .txt para tabela no access sendo que estes estejam fora de um padrão, mas que sigam uma determinada lógica (peço que visualizem o exemplo anexo) a listagem de bancos, no arquivo padrao possue 53 registros e no outro possue 51 (isso ocorre pois os dados sao extraidos de um sistema que traz as informações se houver crédito). Isso acaba tirando o lay out das demais informações.

Alguem conhece alguma solução para importar dados que nao dependa da posição que este esteja?



Obs: Cada arquivo que recebo pode conter a lista de 53 bancos, ou com qualquer contagem menor que essa.

Se puderem me orientar como faço para extrair as informações de baixo para cima (da ultima linha para a primeira), acaba me ajudando bastante.

Em primeiro momento, preciso extrair a informação contida na 7ª linha (de baixo para cima).

Me desculpem pela insistencia, mas pela ausencia de respostas, estou até acreditando que não é possivel importar informações de arquivos de texto.Estou tentando diversas soluções mas sem exito.

Alguem sabe me dizer como faço para identificar o que está escrito em uma determinada linha e após isso contar + 2 linhas e importar os dados para uma tabela no access.?

No exemplo anexo tenho a linha "TOTAL EXPECTED PAYMENTS TO DEBIT/" e eu preciso obter o valor contido 2 linhas abaixo.

Exemplo: txt - Padrão


TOTAL EXPECTED PAYMENTS TO DEBIT/
/FROM COUNTERPARTIES CREDIT
0,000,000.00 C ------> Preciso captar essa informação

Como o arquivo recebido muda a linha conforme a quantidade de registros, tenho que realizar essa importação identificando o que está escrito na linha.

Abaixo, parte do código que estou utilizando:

Do While Not EOF(fnum)
NLinha = nLinha+1
Line Input #fnum, LinhadoTexto

if LinhadoTexto = "TOTAL EXPECTED PAYMENTS TO DEBIT/" Then

....Aqui é que não estou conseguindo evoluir (Quando identificar a linha que possui a informação, esta é somada com mais 2 linha e devolvida com a informação dessa)



end if


rs.AddNew

rs(1) = REPORT

rs.Update

MsgBox "Dados importados", vbInformation, "IMPORTAÇAO EFETUADA"

End Function


Toda ajuda é bem vinda!!!

Obrigado!!!

Olá Leandro,

Você quer pegar somente a informação desta linha que eu grifei em vermelho ?

TOTAL EXPECTED PAYMENTS TO             DEBIT/
     /FROM COUNTERPARTIES             CREDIT
                        0,000,000.00  C    

Sds,

Perfeito!

Isso mesmo.

Olá Leandro,

Esta pequena função atende o que você precisa:

Fiz alguns comentários para você entender o código

É só adaptar a sua necessidade.

Cole esta função em um módulo

Para chamar a função:

Call Importar_txt("Caminho do seu Arquivo.txt")

Código:

Public Function Importar_txt(LocalArquivo As String)
Dim contalinha As Long
Dim nlinha As Long
Dim LinhadoTexto As String
fnum = FreeFile

'#### Abrir o arquivo

Open LocalArquivo For Input As fnum

Do While Not EOF(fnum)

nlinha = nlinha + 1

'#### Iniciar a leitura das linhas

Line Input #fnum, LinhadoTexto

'#### Verificar se existe a string TOTAL EXPECTED PAYMENTS TO na linha

If InStr(LinhadoTexto, "TOTAL EXPECTED PAYMENTS TO") > 0 Then

'#### Se existir preciso pular duas linhas
'#### então uso o Recurso do Input com o uma linha imáginária(Dummy- Boneco)

'#### pulo uma linha
Line Input #fnum, Dummy

'#### pulo a segunda linha, e se precisar de mais é só repetir o código
Line Input #fnum, Dummy

'#### Imprimo na Janela imediata (Ctrl+G) para ver se é a linha que eu quero mesmo

Debug.Print Dummy

'### Verifique na Janela Imediata se chamou a linha correta.

End If

Loop

End Function

Olá Charles!

Muito mas muito obrigado por seu retorno!

Farei os testes e lhe dou um retorno.


fique com Deus e uma boa noite!

Charles,

Você me deu uma grande orientação.
Consegui adaptar em meu projeto e funcionou Legal.

Muito obrigado!!!

obrigado pelo retorno

o fórum agradece.

favor clicar no resolvido


sds,

Amigos boa tarde,

Tive que reabrir o tópico pois surgiu uma nova necessidade.
Atualmente, o código em destaque transporta os dados do txt conforme código que está atrelado ao banco, ou seja, ele busca a lista de bancos emissores conforme o código e retorna o valor.

A minha necessidade é...

Ao inves de atrelar o código do banco Emissor no código, atrelar apenas o nome do banco, assim independente se o código muda ou não, sempre irei buscar todos os valores que pertencer a um determinado banco.

Resumindo, eu preciso realizar a mesma coisa que o código em destaque já faz, porém referenciando sempre quando aparece um nome de um determinado banco, em seguida somar todas as ocorrencias por banco.

obs: No código, fiz um comentário quando é iniciado a importação dos bancos para facilitar a compreensão.

Abaixo o código que já utilizo e que funciona perfeitamente.

Código:

Function ImportaTxt()

'Dim strArqTexto As String
'strArqTexto = Dir(CurrentProject.Path & "\Arquivos Texto\*.txt*")

'    If strArqTexto = "" Then
'        MsgBox "A pasta Arquivos Texto não possui conteúdo a ser importado"
   
'    Else


Dim fso1 As FileSystemObject
Dim F1 As file, Pasta1
Dim strPathFile1 As String, strFile1 As String, strPath1 As String
Dim blnHasFieldNames1 As Boolean
blnHasFieldNames1 = True

Set fso1 = New FileSystemObject

Set Pasta1 = fso1.GetFolder(CurrentProject.Path & "\Arquivos Texto")
For Each F1 In Pasta1.Files
strPathFile1 = CurrentProject.Path & "\Arquivos Texto" & "\" & F1.Name


Dim rs As DAO.Recordset
Dim fnum As Integer
Dim LinhaDoTexto As String
Dim ArquivoTexto As String
Dim nCount As Long
Dim nLinha As Integer
Dim strSQL As String
Dim CaminhoCopia As String
Dim ContaLinha As Long


Dim DATA_TRANSACAO As Variant
Dim DATA_LIQ_FIN As Variant

Dim BRADESCO11102 As Variant
Dim BRADESCO11603 As Variant
Dim BRADESCO4380 As Variant
Dim BRADESCO6175 As Variant

Dim BRADESCARD5144 As Variant
Dim BRADESCARD13757 As Variant
Dim BRADESCARD14075 As Variant

Dim BB4348 As Variant
Dim BB6145 As Variant
Dim BB13454 As Variant
Dim BB13804 As Variant

Dim SANTANDER8328 As Variant
Dim SANTANDER11783 As Variant

Dim CEF4476 As Variant
Dim CEF6492 As Variant

Dim ITAUBB4373 As Variant
Dim ITAUBB6282 As Variant
Dim ITAUBB9970 As Variant
Dim ITAUBB9992 As Variant
Dim ITAUBB12848 As Variant
Dim ITAUBB13755 As Variant

strSQL = "SELECT * FROM TMastercard"

Set rs = CurrentDb.OpenRecordset(strSQL)

ArquivoTexto = strPathFile1

fnum = FreeFile

Open ArquivoTexto For Input As fnum

    Do While Not EOF(fnum)
        nLinha = nLinha + 1
        Line Input #fnum, LinhaDoTexto
       
        If InStr(LinhaDoTexto, "SETTLEMENT DATE:") > 0 Then
          DATA_TRANSACAO = fncModificaData(LTrim(RTrim(Mid(LinhaDoTexto, 29, 11))))
       
        End If
       
            If InStr(LinhaDoTexto, "VALUE DATE:") > 0 Then
                DATA_LIQ_FIN = fncModificaData(LTrim(RTrim(Mid(LinhaDoTexto, 29, 11))))
            End If
       
'==============================================================================
'                          **********        BRADESCO
'==============================================================================
       
 Dim B1, B2, B3, B4 As Integer

'A partir daqui, começo a importar os dados conforme o código Emissor nesse trecho é o 11102 que pertence ao Bradesco
'Eu gostaria de resumir esse trecho substituindo o código do banco Emissor pelo próprio nome e trazer em uma só campo da tabela
'a soma total
       
            If InStr(LinhaDoTexto, 11102) > 0 Then
                B1 = LTrim(RTrim(Mid(LinhaDoTexto, 4, 2)))
            End If
                If LTrim(RTrim(Mid(LinhaDoTexto, 4, 2))) = B1 And InStr(LinhaDoTexto, "BRA") > 0 And InStr(LinhaDoTexto, "C") > 0 Then
                BRADESCO11102 = LTrim(RTrim(Mid(LinhaDoTexto, 22, 16)))
                End If
           
            If InStr(LinhaDoTexto, 11603) > 0 Then
                B2 = LTrim(RTrim(Mid(LinhaDoTexto, 4, 2)))
            End If
                If LTrim(RTrim(Mid(LinhaDoTexto, 4, 2))) = B2 And InStr(LinhaDoTexto, "BRA") > 0 And InStr(LinhaDoTexto, "C") > 0 Then
                BRADESCO11603 = LTrim(RTrim(Mid(LinhaDoTexto, 22, 16)))
                End If
           
            If InStr(LinhaDoTexto, 4380) > 0 Then
                B3 = LTrim(RTrim(Mid(LinhaDoTexto, 4, 2)))
            End If
                If LTrim(RTrim(Mid(LinhaDoTexto, 4, 2))) = B3 And InStr(LinhaDoTexto, "BRA") > 0 And InStr(LinhaDoTexto, "C") > 0 Then
                BRADESCO4380 = LTrim(RTrim(Mid(LinhaDoTexto, 22, 16)))
                End If
               
            If InStr(LinhaDoTexto, 6175) > 0 Then
                B4 = LTrim(RTrim(Mid(LinhaDoTexto, 4, 2)))
            End If
                If LTrim(RTrim(Mid(LinhaDoTexto, 4, 2))) = B4 And InStr(LinhaDoTexto, "BRA") > 0 And InStr(LinhaDoTexto, "C") > 0 Then
                BRADESCO6175 = LTrim(RTrim(Mid(LinhaDoTexto, 22, 16)))
                End If
           
'==============================================================================
'                          **********        Itaú Unibanco
'==============================================================================

Dim I1, I2, I3, I4, I5, I6 As Variant


            If InStr(LinhaDoTexto, 4373) > 0 Then
                I1 = LTrim(RTrim(Mid(LinhaDoTexto, 4, 2)))
            End If
                If LTrim(RTrim(Mid(LinhaDoTexto, 4, 2))) = I1 And InStr(LinhaDoTexto, "BRA") > 0 And InStr(LinhaDoTexto, "C") > 0 Then
                ITAUBB4373 = LTrim(RTrim(Mid(LinhaDoTexto, 22, 16)))
                End If
               
            If InStr(LinhaDoTexto, 6282) > 0 Then
                I2 = LTrim(RTrim(Mid(LinhaDoTexto, 4, 2)))
            End If
                If LTrim(RTrim(Mid(LinhaDoTexto, 4, 2))) = I2 And InStr(LinhaDoTexto, "BRA") > 0 And InStr(LinhaDoTexto, "C") > 0 Then
                ITAUBB6282 = LTrim(RTrim(Mid(LinhaDoTexto, 22, 16)))
                End If
               

            If InStr(LinhaDoTexto, 9970) > 0 Then
                I3 = LTrim(RTrim(Mid(LinhaDoTexto, 4, 2)))
            End If
                If LTrim(RTrim(Mid(LinhaDoTexto, 4, 2))) = I3 And InStr(LinhaDoTexto, "BRA") > 0 And InStr(LinhaDoTexto, "C") > 0 Then
                ITAUBB9970 = LTrim(RTrim(Mid(LinhaDoTexto, 22, 16)))
                End If
               
            If InStr(LinhaDoTexto, 9992) > 0 Then
                I4 = LTrim(RTrim(Mid(LinhaDoTexto, 4, 2)))
            End If
                If LTrim(RTrim(Mid(LinhaDoTexto, 4, 2))) = I4 And InStr(LinhaDoTexto, "BRA") > 0 And InStr(LinhaDoTexto, "C") > 0 Then
                ITAUBB9992 = LTrim(RTrim(Mid(LinhaDoTexto, 22, 16)))
                End If
     
            If InStr(LinhaDoTexto, 12848) > 0 Then
                I5 = LTrim(RTrim(Mid(LinhaDoTexto, 4, 2)))
            End If
                If LTrim(RTrim(Mid(LinhaDoTexto, 4, 2))) = I5 And InStr(LinhaDoTexto, "BRA") > 0 And InStr(LinhaDoTexto, "C") > 0 Then
                ITAUBB12848 = LTrim(RTrim(Mid(LinhaDoTexto, 22, 16)))
                End If

            If InStr(LinhaDoTexto, 13755) > 0 Then
                I6 = LTrim(RTrim(Mid(LinhaDoTexto, 4, 2)))
            End If
                If LTrim(RTrim(Mid(LinhaDoTexto, 4, 2))) = I6 And InStr(LinhaDoTexto, "BRA") > 0 And InStr(LinhaDoTexto, "C") > 0 Then
                ITAUBB13755 = LTrim(RTrim(Mid(LinhaDoTexto, 22, 16)))
                End If
               
'==============================================================================
'                          **********        BANCO DO BRASIL, S.A
'==============================================================================

Dim BB1, BB2, BB3, BB4 As Variant

            If InStr(LinhaDoTexto, 4348) > 0 Then
                BB1 = LTrim(RTrim(Mid(LinhaDoTexto, 4, 2)))
            End If
                If LTrim(RTrim(Mid(LinhaDoTexto, 4, 2))) = BB1 And InStr(LinhaDoTexto, "BRA") > 0 And InStr(LinhaDoTexto, "C") > 0 Then
                BB4348 = LTrim(RTrim(Mid(LinhaDoTexto, 22, 16)))
                End If
               
            If InStr(LinhaDoTexto, 6145) > 0 Then
                BB2 = LTrim(RTrim(Mid(LinhaDoTexto, 4, 2)))
            End If
                If LTrim(RTrim(Mid(LinhaDoTexto, 4, 2))) = BB2 And InStr(LinhaDoTexto, "BRA") > 0 And InStr(LinhaDoTexto, "C") > 0 Then
                BB6145 = LTrim(RTrim(Mid(LinhaDoTexto, 22, 16)))
                End If
               
            If InStr(LinhaDoTexto, 13454) > 0 Then
                BB3 = LTrim(RTrim(Mid(LinhaDoTexto, 4, 2)))
            End If
                If LTrim(RTrim(Mid(LinhaDoTexto, 4, 2))) = BB3 And InStr(LinhaDoTexto, "BRA") > 0 And InStr(LinhaDoTexto, "C") > 0 Then
                BB13454 = LTrim(RTrim(Mid(LinhaDoTexto, 22, 16)))
                End If
               
            If InStr(LinhaDoTexto, 13804) > 0 Then
                BB4 = LTrim(RTrim(Mid(LinhaDoTexto, 4, 2)))
            End If
                If LTrim(RTrim(Mid(LinhaDoTexto, 4, 2))) = BB4 And InStr(LinhaDoTexto, "BRA") > 0 And InStr(LinhaDoTexto, "C") > 0 Then
                BB13804 = LTrim(RTrim(Mid(LinhaDoTexto, 22, 16)))
                End If
               
               
'==============================================================================
'                          **********        BANCO BRADESCARD S.A
'==============================================================================
  '########################################################################################
 'Temporário: O código abaixo corresponde ao banco emissor 15475 - Itau Unibanco S.A
 'Esse código não estava no manual
  Dim BR1, BR2, BR3 As Variant
               
            If InStr(LinhaDoTexto, 14585) > 0 Then
                BR1 = LTrim(RTrim(Mid(LinhaDoTexto, 4, 2)))
            End If
                If LTrim(RTrim(Mid(LinhaDoTexto, 4, 2))) = BR1 And InStr(LinhaDoTexto, "BRA") > 0 And InStr(LinhaDoTexto, "C") > 0 Then
                BRADESCARD5144 = LTrim(RTrim(Mid(LinhaDoTexto, 22, 16)))
                End If
 '#########################################################################################
             
                             
 '########################################################################################
 'Temporário: O código abaixo corresponde ao banco emissor 15475 - Itau Unibanco S.A
 'Esse código não estava no manual
            If InStr(LinhaDoTexto, 15475) > 0 Then
                BR2 = LTrim(RTrim(Mid(LinhaDoTexto, 4, 2)))
            End If
                If LTrim(RTrim(Mid(LinhaDoTexto, 4, 2))) = BR2 And InStr(LinhaDoTexto, "BRA") > 0 And InStr(LinhaDoTexto, "C") > 0 Then
                BRADESCARD13757 = LTrim(RTrim(Mid(LinhaDoTexto, 22, 16)))
                End If
'#########################################################################################
               
            If InStr(LinhaDoTexto, 14075) > 0 Then
                BR3 = LTrim(RTrim(Mid(LinhaDoTexto, 4, 2)))
            End If
                If LTrim(RTrim(Mid(LinhaDoTexto, 4, 2))) = BR3 And InStr(LinhaDoTexto, "BRA") > 0 And InStr(LinhaDoTexto, "C") > 0 Then
                BRADESCARD14075 = LTrim(RTrim(Mid(LinhaDoTexto, 22, 16)))
                End If
               
'==============================================================================
'                          **********        CAIXA ECONOMICA FEDE
'==============================================================================
               
  Dim CEF1, CEF2 As Variant
               
            If InStr(LinhaDoTexto, 4476) > 0 Then
                CEF1 = LTrim(RTrim(Mid(LinhaDoTexto, 4, 2)))
            End If
                If LTrim(RTrim(Mid(LinhaDoTexto, 4, 2))) = CEF1 And InStr(LinhaDoTexto, "BRA") > 0 And InStr(LinhaDoTexto, "C") > 0 Then
                CEF4476 = LTrim(RTrim(Mid(LinhaDoTexto, 22, 16)))
                End If
               
            If InStr(LinhaDoTexto, 6492) > 0 Then
                CEF2 = LTrim(RTrim(Mid(LinhaDoTexto, 4, 2)))
            End If
                If LTrim(RTrim(Mid(LinhaDoTexto, 4, 2))) = CEF2 And InStr(LinhaDoTexto, "BRA") > 0 And InStr(LinhaDoTexto, "C") > 0 Then
                CEF6492 = LTrim(RTrim(Mid(LinhaDoTexto, 22, 16)))
                End If
               
'==============================================================================
'                          **********        BANCO SANTANDER (BRA
'==============================================================================
               
  Dim BS1, BS2 As Variant
               
            If InStr(LinhaDoTexto, 8328) > 0 Then
                BS1 = LTrim(RTrim(Mid(LinhaDoTexto, 4, 2)))
            End If
                If LTrim(RTrim(Mid(LinhaDoTexto, 4, 2))) = BS1 And InStr(LinhaDoTexto, "BRA") > 0 And InStr(LinhaDoTexto, "C") > 0 Then
                SANTANDER8328 = LTrim(RTrim(Mid(LinhaDoTexto, 22, 16)))
                End If
               
            If InStr(LinhaDoTexto, 11783) > 0 Then
                BS2 = LTrim(RTrim(Mid(LinhaDoTexto, 4, 2)))
            End If
                If LTrim(RTrim(Mid(LinhaDoTexto, 4, 2))) = BS2 And InStr(LinhaDoTexto, "BRA") > 0 And InStr(LinhaDoTexto, "C") > 0 Then
                SANTANDER11783 = LTrim(RTrim(Mid(LinhaDoTexto, 22, 16)))
                End If

    Loop
   

    rs.AddNew
   
    rs(1) = DATA_TRANSACAO
    rs(2) = DATA_LIQ_FIN
    rs(3) = BRADESCO11102
    rs(4) = BRADESCO11603
    rs(5) = BRADESCO4380
    rs(6) = BRADESCO6175
   
    rs(7) = BRADESCARD5144
    rs(8) = BRADESCARD13757
    rs(9) = BRADESCARD14075
   
    rs(10) = BB4348
    rs(11) = BB6145
    rs(12) = BB13454
    rs(13) = BB13804
   
    rs(14) = SANTANDER8328
    rs(15) = SANTANDER11783
   
    rs(16) = CEF4476
    rs(17) = CEF6492
   
    rs(18) = ITAUBB4373
    rs(19) = ITAUBB6282
    rs(20) = ITAUBB9970
    rs(21) = ITAUBB9992
    rs(22) = ITAUBB12848
    rs(23) = ITAUBB13755
       
 
    rs.Update
    Close fnum
   
    Call ExecutarBancos
   
    'Envia a soma dos bancos para a tabela TBancosValidos

   

Next
'End If

For Each F1 In Pasta1.Files
fso1.DeleteFile (F1.Path)
Next




End Function

!