Controllo del codice fiscale per VB6 / VBA

Ho realizzato una versione per VB6 del mio controllo del codice fiscale con omocodia

La funzione di controllo

Public Function CheckCodiceFiscale(ByVal codicefiscale As String) As String
    CheckCodiceFiscale = "Errata"
    Const caratteri As Integer = 16
    If codicefiscale & "" = "" Then Exit Function
    If Not Len(codicefiscale) = caratteri Then Exit Function
    Const omocodici As String = "LMNPQRSTUV"
    Const listaControllo As String = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
    Dim listaPari() As Variant
    listaPari = Array(0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25)
    Dim listaDispari() As Variant
    listaDispari = Array(1, 0, 5, 7, 9, 13, 15, 17, 19, 21, 2, 4, 18, 20, 11, 3, 6, 8, 12, 14, 16, 10, 22, 25, 24, 23)
    codicefiscale = UCase(codicefiscale)
    Dim k As Integer
    Dim x As Integer
    Dim cCodice(15) As String
    For k = 0 To 14
        cCodice(k) = Mid(codicefiscale, k + 1, 1)
    Next
    Dim somma As Long
    somma = 0
    Dim i As Integer
    i = 0
    While i < 15
        Dim s As String
        s = cCodice(i)
        x = InStr(1, "0123456789", s)
        If Not (x <= 0) Then
            s = Mid(listaControllo, x, 1)
        End If
        x = InStr(1, listaControllo, s, vbTextCompare)
        If (i Mod 2) = 0 Then
           x = listaDispari(x - 1)
        Else
            x = listaPari(x - 1)
        End If
        somma = somma + x
        i = i + 1
    Wend
    x = somma Mod 26 + 1
    If Mid(listaControllo, x, 1) = Right(codicefiscale, 1) Then
      CheckCodiceFiscale = "Corretto"
    End If
End Function

Programma di esempio

Powerered with Window Live Writer