Feedback

VB - IBAN prüfen und erzeugen in VBA

Veröffentlicht von am 11.05.2016
(0 Bewertungen)
Überprüft die IBAN und gibt zusätzlich die BIC und den Namen der Bank zurück.

Alternativ kann die Prüfziffer durch "??" ersetzt werden, dann liefert sie obige Daten mit der korrekten Prüfziffer.
Aber Vorsicht, bei einigen Banken funktioniert das nicht. Sie vergeben neue Bankleitzahlen und ändern die Kontonummer in dem sie z.B. hinten nullen anhängen.
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "CRuIBAN"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
' Class CRuIBAN
' Überprüft die IBAN und gibt zusätzlich die BIC und den Namen der Bank zurück
' Alternativ kann die Prüfziffer durch "??" ersetzt werden, dann liefert sie obige Daten
' mit der korrekten Prüfziffer

' Init
' Länderkennzeichen + Prüfzenziffer (z.B. "12" oder "??" + BLZ + Kontonummer

' Liefert
' ClassRuIban.IBAN
'            .BIC
'            .Name
'            .Ort
'            .Ok       true/false
' Aufruf
' Dim RuIBAN As CRuIBAN
' Set RuIBAN = New CRuIBAN
' RuIBAN.InitiateProperties IBAN:="DE??370502990123456799"

' If RuIBAN.Ok = True Then
'   Debug.Print (RuIBAN.IBAN)
'   Debug.Print (RuIBAN.Bic)
'   Debug.Print (RuIBAN.Name)
'   Debug.Print (RuIBAN.Ort)
' Else
'   Debug.Print ("IBAN ist fehlerhaft")
' End If
 
' Option Explicit

' Bankleitzahlendatei der Bundesbank
Const BankCodeFile As String = "BankCode.txt"

' Properties
Private m_IBAN As String
Private m_BIC As String
Private m_Name As String
Private m_Ort As String
Private m_Ok As Boolean
' Initiiert das Objekt
' Teilt die IBAN in ihre Bestandteile auf
' und prüft die IBAN
' Setzt Ok auf true oder false
Public Sub InitiateProperties(IBAN As String)
    m_Ok = ISIBAN(IBAN)
    If m_Ok = True Then
        m_IBAN = IBAN
        GetBank Mid(IBAN, 5, 8)
    Else
        m_IBAN = ""
        m_BIC = ""
        m_Name = ""
    End If
End Sub


' Properties Public
Public Property Get IBAN() As String
    IBAN = m_IBAN
End Property
Public Property Get Bic() As String
    Bic = m_BIC
End Property
Public Property Get Name() As String
    Name = m_Name
End Property
Public Property Get Ort() As String
    Ort = m_Ort
End Property

Public Property Get Ok() As Boolean
    Ok = m_Ok
End Property

' Properties Private
Private Property Let IBAN(value As String)
    m_IBAN = value
End Property
Private Property Let Bic(value As String)
    m_BIC = value
End Property
Private Property Let Name(value As String)
    m_Name = value
End Property
Private Property Let Ort(value As String)
    m_Ort = value
End Property

Private Property Let Ok(value As Boolean)
    m_Ok = value
End Property

'Liefert True für korrekte IBAN, sonst false
Public Function ISIBAN(IBAN As String) As Boolean
    Dim mysIBAN As String
    Dim LaenderCode As String
    Dim Pruefsumme As String
    Dim BLZ As String
    Dim Konto As String
    Dim BLZ_Konto As String
    Dim Umstellung As String
    Dim sModulus As String
    Dim Rest As Integer
    Dim CreateIBAN As Boolean
    
    'Leerzeichen entfernen
    mysIBAN = Replace(IBAN, " ", "")
    
    'Eine IBAN hat maximal 34 Stellen
    If (Len(mysIBAN) > 34 Or Len(mysIBAN) < 5) Then GoTo Error_ISIBAN
    
    LaenderCode = UCase(Left(mysIBAN, 2))
    Pruefsumme = UCase(Mid(mysIBAN, 3, 2))
    BLZ = UCase(Mid(mysIBAN, 5, 8))
    Konto = UCase(Mid(mysIBAN, 13))
    BLZ_Konto = BLZ + Right("000000000" + Konto, 10)
        
    ' ist Prüfsumme ok?
    If IsNumeric(Pruefsumme) = False Then
        ' Wenn keine echte Prüfziffer, nur "??" ist erlaubt
        If Pruefsumme <> "??" Then GoTo Error_ISIBAN
        ' IBAN soll erzeugt werden
        CreateIBAN = True
    Else
        ' IBAN soll nur geprüft werden
        CreateIBAN = False
    End If
    
    ' ist LänderCode ok?
    ' nur "DE" implementiert
    If ISLaendercode(LaenderCode) = False Then GoTo Error_ISIBAN
   
    ' IBAN umstellen, BLZ und Konto nach vorne (ISO 3166)
    Umstellung = BLZ_Konto + LaenderCode + "00"
    
    ' A..Z durch Zahlen 10-35 ersetzen
    sModulus = IBANCleaner(Umstellung)
    
    ' Modulo 97-10 (ISO 7064)
    Rest = 98 - Modulo(sModulus, 97)
    
    If CreateIBAN = True Then
        ' "??" wird durch Pruefziffer (Rest) ersetzt
        ' Kontonummer wird auf 10 Stellen rechtsbündig gestetzt
        IBAN = LaenderCode + Right("0" + CStr(Rest), 2) + BLZ_Konto
    Else
        ' Pruefsumme nicht identisch, ERROR
        If Right("0" + CStr(Rest), 2) <> Pruefsumme Then GoTo Error_ISIBAN
Error_ISIBAN
    End If
    ISIBAN = True
Exit_ISIBAN:
    Exit Function
Error_ISIBAN:
    ISIBAN = False
End Function

' Prüft auf den Ländercode
' hier nur DE, weil sonst auch andere Algorithen geändert werden müssen
Private Function ISLaendercode(code As String) As Boolean
    'Der Code muss laut ISO 3166-1 ein 2-stelliger Ländercode aus Buchstaben sein.
    If Len(code) <> 2 Then GoTo Error_ISLaendercode
    
    code = UCase(code)
    Dim Laendercodes As Variant
    
    Laendercodes = Array("DE") ' oder "DE", "FR", ..
     
    Dim I As Integer
    For I = 0 To UBound(Laendercodes)
        If Laendercodes(I) = code Then
            ISLaendercode = True
            Exit For
        Else
            ISLaendercode = False
        End If
    Next I
Exit_ISLaendercode:
    Exit Function
Error_ISLaendercode:
    ISLaendercode = False
End Function

'IBAN Cleaner
' Buchstaben durch Zahlen ersetzen
Private Function IBANCleaner(IBAN As String) As String
    Dim replacewith As Integer
    Dim sreplace As String
    Dim I As Integer
    For I = 65 To 90
        replacewith = I - 64 + 9
        sreplace = Chr(I)
        IBAN = Replace(IBAN, CStr(sreplace), CStr(replacewith))
    Next I
    IBANCleaner = IBAN
End Function
' Modulo für lange Zahlen in 9-Blöcken
Private Function Modulo(sModulus As String, Divisor As Integer) As Integer
    Dim sDividend As String
    Dim Dividend As Long
    Dim sDividendRest As String
    Dim sRest As String
    Dim Rest As Long
    Dim I As Integer
    
    ' Anfang für den 1. Durchlauf
    sRest = ""
    sDividendRest = sModulus
    
    ' Bis zu 4 x durchlaufen
    For I = 0 To 4
        sDividend = Left(sRest + sDividendRest, 9)
        Dividend = CLng(Val(sDividend))
        Rest = Dividend Mod Divisor
        
        ' sDividendRest um (sDivident - sRest) vorne kürzen
        sDividendRest = Mid(sRest + sDividendRest, 10)
        
        ' sRest neu
        sRest = CStr(Rest)
        
        ' wenn sDividendRest = "" Schleife verlassen
        If sDividendRest = "" Then Exit For
    Next I
    Modulo = Rest
End Function

' Setzt BIC und Bankname aus Bankleitzahlendatei der Bundesbank
Private Sub GetBank(BLZ As String)
    Dim dataArray() As String
    
    ' Lese BankCode-Datei in Array
    Open BankCodeFile For Input As #1
    dataArray = Split(Input$(LOF(1), #1), vbLf)
    Close #1
    
    Dim I As Integer
    Dim Pos As Integer
    For I = 0 To UBound(dataArray)
        ' Finde BLZ
        Pos = InStrRev(dataArray(I), BLZ)
        If Pos > 0 Then
            ' setze BIC, Name und Ort der Bank
            m_BIC = Mid(dataArray(I), 140, 11)
            m_Name = Mid(dataArray(I), 108, 27)
            m_Ort = Mid(dataArray(I), 73, 35)
            Exit For
        End If
    Next I
End Sub
Abgelegt unter IBAN, BIC, Modulo.

Kommentare zum Snippet

 

Logge dich ein, um hier zu kommentieren!