Importação de arquivo OFX , para access via codigo

olá galera!

Gostaria de saber se alguem possui , o codigo para efetuar importações para o access de um arquivo em .ofx

recebo vários extratos de vários bancos distintos e gostaria de criar uma ferramenta para importar para meu access.

estou com certa dificuldade , não estou conseguindo predefinir as tags a serem importadas.


obrigado

esse eu importo arquivo da caixa


Public Function ImportaOFX(Caminho As String, cConta As Integer)

Dim DB As Database
Dim RS, r As Recordset
Dim CodOFx As Integer
Dim Sec As Variant
Dim Rotulo, Linha As String
Set DB = CurrentDb

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

nFileNum = FreeFile
Open Caminho For Input As nFileNum
'Form_OFXimport.pbar.Value = 2

'Abrir tabela OFX e adicionar novo extrato
Set r = DB.OpenRecordset("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 = "r!IdBanco = Mid(Linha, 19)
Case Is = "r!IdConta = Mid(Linha, 19)
Case Is = "r!dti = DateSerial(Int(Mid(Linha, 10, 4)), Int(Mid(Linha, 14, 2)), Int(Mid(Linha, 16, 2)))
Case Is = "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
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
'Form_OFXimport.pbar.Value = 50
Set RS = DB.OpenRecordset("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 (>)
Rotulo = Sec(0) 'pega a primeira parte da seção

Select Case Rotulo
Case Is = " RS.AddNew
Case Is = " '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 = " 'armazena a data
RS!data = DateSerial(Int(Mid(Linha, 11, 4)), Int(Mid(Linha, 15, 2)), Int(Mid(Linha, 17, 2)))
Case Is = " 'armazena o valor
If RS!tipo = 1 Then
RS!Valor = FormatCurrency(Mid(Linha, 9), 2, vbUseDefault, vbUseDefault, vbUseDefault) / 100
RS!Credito = FormatCurrency(Mid(Linha, 9), 2, vbUseDefault, vbUseDefault, vbUseDefault) / 100
Else
RS!Valor = FormatCurrency(Mid(Linha, 10), 2, vbUseDefault, vbTrue, vbUseDefault) / 100
RS!Debito = FormatCurrency(Mid(Linha, 10), 2, vbUseDefault, vbTrue, vbUseDefault) / 100
End If
Case Is = " 'armazena o cheque
RS!Doc = Mid(Linha, 11)
Case Is = " 'armazena o memorando
RS!Memorando = Mid(Linha, 7)
Case Is = " 'armazena o CODOFX
RS!OFX = CodOFx
RS.Update
Case Is = " RS.Close
'sai da função
End Select
passadireto:
'Form_OFXimport.pbar.Value = Form_OFXimport.pbar.Value + 0.1
Loop

Close nFileNum
'Form_OFXimport.pbar.Value = 100
MsgBox "OFX importado com sucesso!", vbInformation, "Mensagem"
'Form_OFXimport.pbar.Value = 0.0001
Set DB = Nothing
Set RS = Nothing
End Function

valeu  NADIRO , vou aplicar o código e se funcionar para os outros bancos posto e aviso.

=)

Bom dia! desculpe a demora ,  o código funcionou para a importação do , ITAU e do BB  , porem ele da pau no do bradesco , pois o arquivo não vem estruturado.
No caso do Bradesco ele vem sem  quebras de linha o código todo , e o seu código faz a verificação linha a linha como o Bradesco traz em uma unica linha ele não consegue efetuar a leitura.

eu estava verificando e a estrutura do OFX e muito similar ao XML , porem o OFX não possui tags de fechamento quando falamos dos lançamentos.

será que este seria mais viável para a importação sobre qualquer banco? alguém teve o mesmo problema ?

Olá pessoal,

Me interessei por esta rotina de importação de arquivos OFX e adaptei ela para trabalhar com o arquivo OFX que o Itau gera.
Deu tudo certo para o Itau, mas não consegui fazer ela funcionar importando o arquivo OFX do Nubank.

Alguém já passou por esta dificuldade com o Nubank ou outros bancos?
Parece que para o arquivo do Itaú, ele pega certinho o rótulo da seção do arquivo e extraindo seus rótulos:
Exemplo:
Sec = Split(Linha, ">", 2, vbTextCompare) 'seciona a linha (>)
Rotulo = Sec(0) 'pega a primeira parte da seção

Já no arquivo do Nubank, ele não consegue ler linha a linha seu rótulos...
Será que existe variações de arquivos OFX?
Gostaria de receber informações de amigos que passaram pela mesma dificuldade..

Obrigado,
Renato

Olá pessoal,

A rotina funciona legal com o arquivo OFX do Itau, mas não faz o mesmo com outros arquivo OFX, do Nubank por exemplo.
Percebi que o problema é na codificação do arquivo gerado, depois que fiz um teste... limpei manualmente o arquivo do itau (que funciona) e colei nele todo o conteúdo que estava no arquivo do nubank, assim o código funcionou normalmente e conseguiu importar os dados.

Como obter o mesmo resultado do OFX do Itaú para os demais bancos?
Será que automatizar copia dos dados no arquivo do Itaú antes de importar? (ficaria horrível).

Boa tarde a todos!

Eu não tenho muito conhecimento VB, será que alguem poderia disponibilizar o banco de dados com o resultado final?

Boa tarde Pessoal,

Alguém poderia enviar um bd de exemplo para que eu possa tentar remontar conforme meu caso?