Você que precisa de uma rotina de importação de arquivo com extensão OFX para a realização de conciliação bancária, segue o código abaixo:
Private Function DataFormatada(Data As String) As String
DataFormatada = Mid(Data, 7, 2) & "/" & Mid(Data, 5, 2) & "/" & Mid(Data, 1, 4)
End Function
Public Function ImportarXML(ByVal strCaminho As String) As Long
On Error GoTo TrataErro
Dim strArquivo As String
Dim i As Integer
Dim n As Long
Dim lngPosicaoInicial As Long
Dim lngPosicaoFinal As Long
Dim lngPosicaoAuxiliar As Long
Dim strTransacoes() As String
' Ler arquivo
n = FreeFile()
Open strCaminho For Input As #n
strArquivo = Input(LOF(n), n)
Close #n
'Id do banco e da conta
Dim lngIdBanco As Long
Dim lngIdConta As Long
lngPosicaoAuxiliar = InStr(strArquivo, "<BANKID>")
lngIdBanco = Mid(strArquivo, lngPosicaoAuxiliar + 8, InStr(strArquivo, "<ACCTID>") - (lngPosicaoAuxiliar + 8))
lngPosicaoAuxiliar = InStr(strArquivo, "<ACCTID>")
lngIdBanco = Mid(strArquivo, lngPosicaoAuxiliar + 8, InStr(strArquivo, "<ACCTTYPE>") - (lngPosicaoAuxiliar + 8))
' Data de incio e fim
Dim strDataInicio As String
Dim strDataTermino As String
' Formato original YYYYMMDD
lngPosicaoAuxiliar = InStr(strArquivo, "<DTSTART>")
strDataInicio = Mid(strArquivo, lngPosicaoAuxiliar + 9, 8)
strDataInicio = DataFormatada(strDataInicio)
lngPosicaoAuxiliar = InStr(strArquivo, "<DTEND>")
strDataTermino = Mid(strArquivo, lngPosicaoAuxiliar + 7, 8)
strDataTermino = DataFormatada(strDataTermino)
' Lista de transaes
lngPosicaoInicial = InStr(strArquivo, "<BANKTRANLIST>")
lngPosicaoFinal = InStr(strArquivo, "</BANKTRANLIST>")
strArquivo = Mid(strArquivo, lngPosicaoInicial + 14, lngPosicaoFinal)
' Separa as transaes
strTransacoes = Split(strArquivo, "<STMTTRN>")
Dim varItem As Variant
Dim strTipo As String
Dim strData As String
Dim dblValor As Double
Dim strDescricao As String
For Each varItem In strTransacoes
' C - Crdito ou D - Dbito
lngPosicaoAuxiliar = InStr(varItem, "<TRNTYPE>")
If Not (lngPosicaoAuxiliar = 0) Then
strTipo = Mid(varItem, lngPosicaoAuxiliar + 9, 1)
lngPosicaoAuxiliar = InStr(varItem, "<DTPOSTED>")
strData = Mid(varItem, lngPosicaoAuxiliar + 10, 8)
strData = DataFormatada(strData)
lngPosicaoAuxiliar = InStr(varItem, "<TRNAMT>")
dblValor = Mid(varItem, lngPosicaoAuxiliar + 8, InStr(varItem, "<FITID>") - (lngPosicaoAuxiliar + 8))
lngPosicaoAuxiliar = InStr(varItem, "<MEMO>")
strDescricao = Mid(varItem, lngPosicaoAuxiliar + 6, InStr(varItem, "</STMTTRN>") - (lngPosicaoAuxiliar + 6))
End If
Next
MsgBox "Conciliao concluda", vbInformation, TITULO_AVISO
Exit Function
TrataErro:
ImportarXML = 0
Erro.exibirMsgErro Err, "ImportarXML"
Erro.gravarLogErro Err, "ImportarXML"
End Function
Assinar:
Postar comentários (Atom)
-
Segue uma lista com inscrições estaduais para a realização de testes de software:
-
Então, eu estava com este problema ao abrir o VB. Eu não tinha feito nada e o erro ocorreu depois que eu desinstalei alguns programas no meu...
-
Código de exemplo para você que precisa remover de uma string espaços extras, como espaços duplos, por exemplo.
show, me salvou... abraço
ResponderExcluir