[Resolvido]Importação OFX

Boa tarde Pessoal gostaria de saber se alguém pode me ajudar usei código abaixo, mas porém para o ofx gerado no banco do brasil não salva as informações, com o banco sicredi funcionou perfeito mas banco do brasil não, se alguém tiver alguma sugestão ficarei agradecido, pois preciso muito implantar esse código no sistema para fazer a conciliação da conta, desde já agradeço a colaboração dos amigos.

Obs: não sei de quem é o código, por favor informe para que possa dar crédito ao criador.

Código:

Código:

Public Function ImportaOFX(ByVal caminho As String, ByVal cConta As String)

Dim db As Database
Dim rs As Recordset
Dim r As Recordset
Dim CodOFx As Integer
Dim Sec As Variant
Dim Rotulo As String
Dim Linha As String
Set db = CurrentDb

caminho = Me.txtCaminho
cConta = Me.txtConta

'Abrir arquivo, adicionar novo extrato na tabela OFX
'---------------------------------------------------

nFileNum = FreeFile
Open caminho For Input As nFileNum

'Abrir tabela tbl_OFX e adicionar novo extrato
Set r = db.OpenRecordset("tbl_OFX", dbOpenDynaset)
r.AddNew
r!NomeExtrato = "EXT-" & cConta & Format(Time, "HHssmm")
r!Data = Format(Date, "dd/mm/yyyy", vbUseSystemDayOfWeek, vbUseSystem)
r!Conta = cConta

'Percorre linha por linha do arquivo
Do Until EOF(nFileNum)
Line Input #nFileNum, slinetext

If slinetext = "" Then 'se a linha é vazia, vai pra próxima!
GoTo pulalinha
End If

Linha = LTrim(Replace(slinetext, vbTab, " ")) 'Substitui as tabulações por espaços e corta os espaços
Sec = Split(Linha, ">", 2, vbTextCompare) 'Secciona a linha até o caracter >
Rotulo = Sec(0) 'pega a primeira parte da seção

Select Case Rotulo
Case Is = "<BANKID"
r!idbanco = Mid(Linha, 9, 4)
Case Is = "<ACCTID"
r!idconta = Mid(Linha, 9, 15)
Case Is = "<DTSTART"
r!dti = DateSerial(Int(Mid(Linha, 10, 4)), Int(Mid(Linha, 14, 2)), Int(Mid(Linha, 16, 2)))
Case Is = "<DTEND"
r!dtf = DateSerial(Int(Mid(Linha, 8, 4)), Int(Mid(Linha, 12, 2)), Int(Mid(Linha, 14, 2)))
End Select
pulalinha:
'Form_OFXimport.pbar.Value = Form_OFXimport.pbar.Value + 0.1 'Barra de progresso
Loop

r.Update
r.MoveLast

CodOFx = r!cod 'pega o código do extrato salvo para vincular os movimentos

r.Close
Close nFileNum
Set r = Nothing

'Agora lançar os movimentos
'-------------------------------------------------------------------------

Open caminho For Input As nFileNum 'abre o mesmo arquivo

Set rs = db.OpenRecordset("tbl_SubOFX", dbOpenDynaset) 'abre a tabela para receber os dados

Do Until EOF(nFileNum)
Line Input #nFileNum, slinetext

If slinetext = "" Then 'se a linha é vazia, pula ela!
GoTo passadireto
End If

Linha = LTrim(Replace(slinetext, vbTab, " ")) 'substitui as tabulações por espaços e corta os espaços
Sec = Split(Linha, ">", 2, vbTextCompare) 'secciona a linha (>Piscando
Rotulo = Sec(0) 'pega a primeira parte da seção

Select Case Rotulo
Case Is = "<STMTTRN"
rs.AddNew
Case Is = "<TRNTYPE"
'define o tipo = 1 ou 2 e armazena
If Mid(Linha, 10, 5) = "DEBIT" Then
rs!Tipo = 2
Else
rs!Tipo = 1
End If
Case Is = "<DTPOSTED"
'armazena a data
rs!Data = DateSerial(Int(Mid(Linha, 11, 4)), Int(Mid(Linha, 15, 2)), Int(Mid(Linha, 17, 2)))
Case Is = "<TRNAMT"
'armazena o valor
If rs!Tipo = 1 Then
rs!Valor = Replace(Mid(Linha, 9), ".", ",")
Else
rs!Valor = Replace(Mid(Linha, 10), ".", ",")
End If
Case Is = "<CHECKNUM"
'armazena o cheque
rs!doc = Mid(Linha, 11, 6)
Case Is = "<MEMO"
'armazena o memorando
rs!Memorando = Mid(Linha, 7, 50)
Case Is = "</STMTTRN"
'armazena o CODOFX
rs!OFX = CodOFx
rs.Update
Case Is = "</OFX"
rs.Close
'sai da função
End Select
passadireto:

Loop

Close nFileNum

MsgBox "Arquivo OFX importado com sucesso!", vbInformation, "Mensagem"

Set db = Nothing
Set rs = Nothing
End Function

Olá Elisandro,

Desconheço o formato OFX, pode partilhar ficheiro de amostragem e respetivo conteodo correto pretendo para se analisar.
Assim fica mais fácil para qualquer membro poder ajudar.

Abraço

Boa Noite, ahteixeira

Desculpa responder somente agora é fiquei ausente esses dias, e obrigado por se dispor em me ajudar.

Então uso esse código para importar dados do arquivo que baixamos dos extratos bancários em OFX, mas de um banco eu consigo do outro não.

Não consigo anexar os arquivos da um erro.

Os seguintes erros foram encontrados
O arquivo adicionado não é valido.

Olá Lisandro,

Veja como anexar:
https://www.maximoaccess.com/t28813-como-adicionar-arquivo-ficheiro-a-mensagem-no-forum

Abraço

Boa Noite, ahteixeira

Segue o arquivo para sua analise, seguem dois ficheiros ofx um que importa normal, e o outro que não importa para tabela.

Olá Elisandro,

Tive oportunidade de ver os ficheiros hoje.
Podemos verificar que apesar de serem semelhantes, parece ser versões (do ficheiro) diferentes.

O ficheiro que não está a dar erro ao importar a formatação é XML.

Pesquise no fórum, existe vários exemplos , será ajustar.
Qualquer coisa estamos cá.

Abraço

Olá ahteixeira

Obrigado por me ajudar, então eu dei uma pesquisa aqui no forum mas não encontrei nada com relação a esse problema.

Vou continuar pesquisando, de qualquer forma obrigado!

Ah Teixeira,

Localizei aqui no forum um exemplo que resolveu meu problema deu certo, ele converte o arquivo antes de importar.

https://www.maximoaccess.com/t26865-resolvidoconverter-arquivo-de-texto-unix-em-windows#189411

Olá Elisandro,

Que bom ter resolvido!
Obrigado pelo retorno, o fórum agradece.

Abraço