Início
![[Resolvido]Arquivo texto com conteúdo quebrado na linha. Empty](https://2img.net/i/empty.gif)
XPTOS 29/7/2017, 19:42Olá amigos,
Achei no fórum um exemplo que realiza importação de arquivo de retorno Caixa Econômica Federal.
No formulário Importar Txt eu chamo a função ImportaTxt(banco As String), até ai tudo legal, porém ao ler o conteúdo do arquivo começando da linha 3 em diante, como segue:
Exemplo link:
dropbox.com/s/9xy5gmd9c1nvay4/Arquivo%20Texto.rar?dl=1
NomeCliente = Mid(LinhaDoTexto, 43, 31)
ContaCliente = Mid(LinhaDoTexto, 25, 18)
Endereco = Mid(LinhaDoTexto, 33, 30)
DataVencimento = Mid(LinhaDoTexto, 94,
DataVencimento = Left(DataVencimento, 2) & "/" & Mid(DataVencimento, 3, 2) & "/" & Right(DataVencimento, 4)
valorPago = Mid(LinhaDoTexto, 129, 6)
valorPago = CDbl(Left(valorPago, 4) & "," & Right(valorPago, 2))
Meu problema está neste campo Endereco = Mid(LinhaDoTexto, 33, 30), pois ele sempre está um linha abaixo do conteúdo que estou lendo na variavel LinhaDoTexto), ou seja, se estou lendo a linha 3 o endereço está na linha 4.
Alguém ja passou por algo semelhante?
Achei no fórum um exemplo que realiza importação de arquivo de retorno Caixa Econômica Federal.
No formulário Importar Txt eu chamo a função ImportaTxt(banco As String), até ai tudo legal, porém ao ler o conteúdo do arquivo começando da linha 3 em diante, como segue:
Exemplo link:
dropbox.com/s/9xy5gmd9c1nvay4/Arquivo%20Texto.rar?dl=1
NomeCliente = Mid(LinhaDoTexto, 43, 31)
ContaCliente = Mid(LinhaDoTexto, 25, 18)
Endereco = Mid(LinhaDoTexto, 33, 30)
DataVencimento = Mid(LinhaDoTexto, 94,
DataVencimento = Left(DataVencimento, 2) & "/" & Mid(DataVencimento, 3, 2) & "/" & Right(DataVencimento, 4)
valorPago = Mid(LinhaDoTexto, 129, 6)
valorPago = CDbl(Left(valorPago, 4) & "," & Right(valorPago, 2))
Meu problema está neste campo Endereco = Mid(LinhaDoTexto, 33, 30), pois ele sempre está um linha abaixo do conteúdo que estou lendo na variavel LinhaDoTexto), ou seja, se estou lendo a linha 3 o endereço está na linha 4.
Alguém ja passou por algo semelhante?
- Código:
'---------------------------------------------------------------------------------------
' Procedure : ImportaTxt
' Author : Harysohn P. Pina (PILOTO) - Harysohn@hotmail.com
' Fórum : Fórum Máximo Access - http://www.maximoaccess.com/
' Date : 03/09/2013
' Comentários : Importa arquivo de retorno do Banco do Brasil
'---------------------------------------------------------------------------------------
Function ImportaTxt(banco As String)
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
On Error GoTo TrataErro
Dim NomeProcedimento As String
NomeProcedimento = "ImportaTxt"
'Adiciona o nome do procedimento à função
PegaProcedimento (NomeProcedimento)
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Dim rs As DAO.Recordset
Dim fnum As Integer
Dim LinhaDoTexto As String
Dim ArquivoTexto As String
Dim X As Integer
Dim nCount As Long
Dim nLinha As Integer
Dim StrSQL As String
Dim CaminhoCopia As String
'---------------------------------
'Variáveis para comportar os dados
'---------------------------------
Dim NossoNumero As Variant
Dim databaixa As Variant
Dim valor11 As Variant
Dim dscr As Variant
Dim VrBaixaCr As Variant
Dim jmcr As Variant
'=================================
'---------------------------------------------------
'Carrega a variável com o SQL da tabela Respectiva
'---------------------------------------------------
Select Case banco
Case "Caixa Econômica"
StrSQL = "SELECT * FROM CaixaArquivoRetorno"
End Select
'---------------------------------------------------
'Carrego o recordset com a SQL
'---------------------------------------------------
Set rs = CurrentDb.OpenRecordset(StrSQL)
'---------------------------------------------------
'Carrego a variácel com o caminho do arquivo texto
'---------------------------------------------------
ArquivoTexto = StrCaminho
'-------------------------------------------------------------
'Variável para representar o número da linha do arquivo texto
'-------------------------------------------------------------
nLinha = 0
'-------------------------------------------------------------
'variável para ser utilizada com diferentes delimitadores
'-------------------------------------------------------------
X = 0
fnum = FreeFile
'--------------------
'Abre o arquivo texto
'--------------------
Open ArquivoTexto For Input As fnum
'-------------------------
'Realiza loop pelo arquivo
'-------------------------
Do While Not EOF(fnum)
If EOF(fnum) Then Exit Do
'------------------------------------------------------------
'Aplica à variável o valor de 1, para a primeira linha do txt
'------------------------------------------------------------
nLinha = nLinha + 1
Line Input #fnum, LinhaDoTexto
'------------------------------
'Aplica o case conforme o Banco
'------------------------------
Select Case banco
'---------------------------
'Case para Caixa Econômica
'-------------------------
Case "Caixa Econômica"
'---------------------------------------
'Exclui a primeira linha do procedimento
'---------------------------------------
If nLinha <= 2 Then GoTo ProximaLinha
'-----------------------------------------------------------------
'Nosso Numero
'-----------------------------------------------------------------
NossoNumero = Mid(LinhaDoTexto, 43, 31)
'MsgBox "NossoNumero - " & NossoNumero & " >>> " & Len(NossoNumero) & " - Caracteres"
'-----------------------------------------------------------------
'Jmcr
'-----------------------------------------------------------------
jmcr = Mid(LinhaDoTexto, 25, 18)
'MsgBox "JmCr - " & jmcr & " >>> " & Len(jmcr) & " - Carecteres"
'-----------------------------------------------------------------
'Dscr
'-----------------------------------------------------------------
dscr = Mid(LinhaDoTexto, 33, 30)
'MsgBox "Dscr - " & dscr & " >>> " & Len(dscr) & " - Caracteres"
'-----------------------------------------------------------------
'DataBaixa
'-----------------------------------------------------------------
databaixa = Mid(LinhaDoTexto, 94,
databaixa = Left(databaixa, 2) & "/" & Mid(databaixa, 3, 2) & "/" & Right(databaixa, 4)
'MsgBox "DataBaixa - " & databaixa & " >>> " & Len(databaixa) & " - Caracteres"
'-----------------------------------------------------------------
'Valor11
'-----------------------------------------------------------------
valor11 = Mid(LinhaDoTexto, 129, 6)
valor11 = CDbl(Left(valor11, 4) & "," & Right(valor11, 2))
'MsgBox "Valor11 - " & valor11 & " >>> " & Len(valor11) & " - Caracteres"
'------------------------------------------------------------------
'Incremento o valor de X para utilizar o Delimitador correspondente
'------------------------------------------------------------------
X = X + 2
'-------------------------------
'Numerador de linhas percorridas
'-------------------------------
nCount = nCount + 1
'-------------------------
End Select
'-------------------------------
'Adiciona os registros na tabela
'-------------------------------
rs.AddNew
On Error Resume Next
rs(1) = NossoNumero
rs(2) = databaixa
rs(3) = valor11
rs(4) = dscr
rs(5) = VrBaixaCr
rs(6) = jmcr
rs.Update
'------------------------------------------------------
'Esta instrução será executada após ocorre o erro 3421
'O Erro ocorre na última linha do arquivo txt que não
'será importada
'------------------------------------------------------
Continuar:
ProximaLinha:
'----------------------------------------------------------------------
'Volto o valor de X = 0 para iniciar Delimitadores para a próxima linha
'----------------------------------------------------------------------
X = 0
'----------------------------------------------
'Loop da instrução >> Do While Not EOF(fnum) <<
'----------------------------------------------
Loop
'-------------------
'Fecha arquivo texto
'-------------------
Close fnum
'==========================================================================
'Rotina para copiar o arquivo para a pasta importado
'--------------------------------------------------------------------------
Select Case banco
Case "Caixa Econômica"
CaminhoCopia = CurrentProject.Path & "\Baixados\Caixa\" & StrArquivo
nCount = nCount - 2
End Select
'-----------------------
'limpa a caixa de opções
'-----------------------
Me.OpBanco = 0
Me.OpBanco_2 = 0
'-------------
'Executa cópia
'-------------
FileCopy StrCaminho, CaminhoCopia
'-------------------------
'Deleta o arquivo original
'-------------------------
'Kill StrCaminho
'----------------------
'Gera log de importação
'----------------------
'CurrentDb.Execute "INSERT INTO tblLogRetorno (NomeArquivo,NumeroRegistros,CpData) Values (" _
& """" & StrArquivo & """,""" & nCount & """, #" & Format(Date, "mm/dd/yyyy") & "#)"
'---------------------------------
'Executa atualização nas ListBox's
'---------------------------------
Me.lstCaixa.Requery
'------------------------------------------------
'Mesagem de operação realizada
'------------------------------------------------
MsgBox "Foram importados " & Format$(nCount) & " Registro(s)", vbInformation, "IMPORTAÇAO EFETUADA"
Exit Function
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'Tratamento de Erros
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Exit_TrataErro:
DoCmd.Hourglass False
DoCmd.Echo True
Exit Function
TrataErro:
Select Case Err.Number
Case 13
Resume Next
Case 3421
GoTo Continuar
Case Else
DoCmd.Hourglass False
DoCmd.Echo True
'Chama a função global de tratamento de erros
GlobalErrHandler (Me.Name)
End Select
End Function
