Visual Basic: Importar conciliação bancária

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

Um comentário: