DNI-NIE-NIF

Public Function Validar_NIF_CIF_NIE(Codigo As String) As Boolean

Dim strDigito As String

Dim strCodigoInicial As String

Dim respuesta As String

Dim X As Integer

Dim strPri, strUlt, strResto, strImpares(1 To 4) As String

Dim I, iSuma As Integer

Dim stEsNumero, stEsLetra As Boolean

On Error GoTo Validar_NIF_CIF_NIE_Error

Validar_NIF_CIF_NIE = True

' DNI : 0 + 8 + N

' NIE : N + 7 + N

' DNI : N + 7 + N

Const constLetra As String = "TRWAGMYFPDXBNJZSQVHLCKE"

Const constAbecedario As String = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"

Const constNumeros As String = "0123456789"

' comprobamos el nº de caracteres

Select Case Len(Codigo)

Case Is < 9

' este caso es solo para los dni cuyas posiciones a la izquierda haya que rellenar a ceros

stEsNumero = False: stEsLetra = False

strPri = UCase(left(Codigo, 1)) ' 1ª posición debe de ser un nº para DNI o letras para NIE

strUlt = right(Codigo, 1) ' ultima posición debe de ser nº o letra

'comprobamos si empieza por [X-Y-Z] en cuyo caso se trata de NIES a los que le falta la letra final de control

'en estos casos sustituimos las letras iniciales del nie por sus nº correspondientes y los tratamos como DNI

'en cualquier otro caso ERROR

If InStr(1, constAbecedario, strPri) > 0 Then

' como empiza por letra nos introducimos en busca del nie, pero antes comprobamos que todo el resto de la cadena son nº

For I = 2 To Len(Codigo)

If Not IsNumeric(Mid(Codigo, I, 1)) Then

Validar_NIF_CIF_NIE = False

Exit Function

End If

Next I

Select Case strPri

Case "X"

strDigito = "0" & right(Codigo, Len(Codigo) - 1)

MsgBox " Es un NIE"

If strDigito + Mid(constLetra, (left(strDigito, Len(strDigito)) Mod 23) + 1, 1) = "0" + right(Codigo, Len(Codigo) - 1) + Mid(constLetra, (right(Codigo, Len(Codigo) - 1) Mod 23) + 1, 1) Then

Validar_NIF_CIF_NIE = True

If IsOpen("Mantener_Entidades") Then Form_Mantener_Entidades.txtnif.Value = Codigo + Mid(constLetra, (left(strDigito, Len(strDigito)) Mod 23) + 1, 1)

Exit Function

Else

MsgBox " Error en el NIE consultado"

Validar_NIF_CIF_NIE = False

Exit Function

End If

Case "Y"

strDigito = "1" & right(Codigo, Len(Codigo) - 1)

MsgBox " Es un NIE"

If strDigito + Mid(constLetra, (left(strDigito, Len(strDigito)) Mod 23) + 1, 1) = "0" + right(Codigo, Len(Codigo) - 1) + Mid(constLetra, (right(Codigo, Len(Codigo) - 1) Mod 23) + 1, 1) Then

Validar_NIF_CIF_NIE = True

If IsOpen("Mantener_Entidades") Then Form_Mantener_Entidades.txtnif.Value = Codigo + Mid(constLetra, (left(strDigito, Len(strDigito)) Mod 23) + 1, 1)

Exit Function

Else

MsgBox " Error en el NIE consultado"

Validar_NIF_CIF_NIE = False

Exit Function

End If

Case "Z"

strDigito = "2" & right(Codigo, Len(Codigo) - 1)

MsgBox " Es un NIE"

If strDigito + Mid(constLetra, (left(strDigito, Len(strDigito)) Mod 23) + 1, 1) = "0" + right(Codigo, Len(Codigo) - 1) + Mid(constLetra, (right(Codigo, Len(Codigo) - 1) Mod 23) + 1, 1) Then

Validar_NIF_CIF_NIE = True

If IsOpen("Mantener_Entidades") Then Form_Mantener_Entidades.txtnif.Value = Codigo + Mid(constLetra, (left(strDigito, Len(strDigito)) Mod 23) + 1, 1)

Exit Function

Else

MsgBox " Error en el NIE consultado"

Validar_NIF_CIF_NIE = False

Exit Function

End If

Case Else

' como es una letra diferente debe de tratarse de un error

respuesta = MsgBox("El código introducido no se corresponde ni con un CIF ni con un NIF ni con un NIE, verifíquelo.", vbOKOnly + vbCritical, "Balances")

Validar_NIF_CIF_NIE = False

Exit Function

End Select

End If

' Constatamos que empieza por nº

If InStr(constNumeros, strPri) <> 0 Then

stEsNumero = True

' Vemos si el ultimo caracter es letra o nº y guardamos el resultado

If InStr(constAbecedario, strUlt) <> 0 Then stEsLetra = True

If InStr(constNumeros, strUlt) <> 0 Then stEsNumero = True

' aqui pueden pasar dos cosas: 1ª que sea letra ; 2º que sea número

If stEsNumero = True Then

' en este caso hay previamente que añadirle la letra final de control que le falta despues de verificar que todos los

' caracteres intermedios son nº

' comprobamos que todos los caracteres intermedios son nº

strDigito = ""

For X = 1 To (Len(Codigo) - 1)

If InStr(1, constAbecedario, Codigo) <> 0 Then

' como hay letras intermedias , es un error

respuesta = MsgBox("El código introducido no se corresponde ni con un CIF ni con un NIF ni con un NIE, verifíquelo.", vbOKOnly + vbCritical, "Balances")

Validar_NIF_CIF_NIE = False

Exit Function

End If

Next X

End If

If stEsLetra = True Then

' comprobamos que todos los caracteres intermedios son nº

strDigito = ""

For X = 1 To (Len(Codigo) - 1)

strDigito = Mid(Codigo, X, 1)

If InStr(1, constAbecedario, strDigito) <> 0 Then

' como hay letras intermedias , es un error

respuesta = MsgBox("El código introducido no se corresponde ni con un CIF ni con un NIF ni con un NIE, verifíquelo.", vbOKOnly + vbCritical, "Balances")

Validar_NIF_CIF_NIE = False

Exit Function

End If

Next X

End If

' Ahora aplicamos los datos anteriores de finalización sgún tipologia, nº o letra

If stEsLetra = True Then strCodigoInicial = Codigo: Codigo = left(Codigo, Len(Codigo) - 1): stEsNumero = False

If stEsNumero = True Then Codigo = Codigo: stEsLetra = False

' como todos son nº hay que rellenar hasta 8 digitos con ceros a la izquierda si el nº es menor

Select Case Len(Codigo)

Case 1

strDigito = "0000000" & Codigo & Mid(constLetra, (("0000000" & Codigo) Mod 23) + 1, 1)

If stEsLetra = True Then

If strDigito = "0000000" & strCodigoInicial Then

Validar_NIF_CIF_NIE = True

Else

Validar_NIF_CIF_NIE = False

End If

End If

If stEsNumero = True Then

If strDigito = "0000000" & Codigo & Mid(constLetra, (Codigo Mod 23) + 1, 1) Then

Validar_NIF_CIF_NIE = True

If IsOpen("Mantener_Entidades") Then Form_Mantener_Entidades.txtnif.Value = strDigito

Else

Validar_NIF_CIF_NIE = False

End If

End If

Exit Function

Case 2

strDigito = "000000" & Codigo & Mid(constLetra, (("000000" & Codigo) Mod 23) + 1, 1)

If stEsLetra = True Then

If strDigito = "000000" & strCodigoInicial Then

Validar_NIF_CIF_NIE = True

Else

Validar_NIF_CIF_NIE = False

End If

End If

If stEsNumero = True Then

If strDigito = "000000" & Codigo & Mid(constLetra, (Codigo Mod 23) + 1, 1) Then

Validar_NIF_CIF_NIE = True

If IsOpen("Mantener_Entidades") Then Form_Mantener_Entidades.txtnif.Value = strDigito

Else

Validar_NIF_CIF_NIE = False

End If

End If

Exit Function

Case 3

strDigito = "00000" & Codigo & Mid(constLetra, (("00000" & Codigo) Mod 23) + 1, 1)

If stEsLetra = True Then

If strDigito = "00000" & strCodigoInicial Then

Validar_NIF_CIF_NIE = True

Else

Validar_NIF_CIF_NIE = False

End If

End If

If stEsNumero = True Then

If strDigito = "000000" & Codigo & Mid(constLetra, (Codigo Mod 23) + 1, 1) Then

Validar_NIF_CIF_NIE = True

If IsOpen("Mantener_Entidades") Then Form_Mantener_Entidades.txtnif.Value = strDigito

Else

Validar_NIF_CIF_NIE = False

End If

End If

Exit Function

Case 4

strDigito = "0000" & Codigo & Mid(constLetra, (("0000" & Codigo) Mod 23) + 1, 1)

If stEsLetra = True Then

If strDigito = "0000" & strCodigoInicial Then

Validar_NIF_CIF_NIE = True

Else

Validar_NIF_CIF_NIE = False

End If

End If

If stEsNumero = True Then

If strDigito = "0000" & Codigo & Mid(constLetra, (Codigo Mod 23) + 1, 1) Then

Validar_NIF_CIF_NIE = True

If IsOpen("Mantener_Entidades") Then Form_Mantener_Entidades.txtnif.Value = strDigito

Else

Validar_NIF_CIF_NIE = False

End If

End If

Exit Function

Case 5

strDigito = "000" & Codigo & Mid(constLetra, (("000" & Codigo) Mod 23) + 1, 1)

If stEsLetra = True Then

If strDigito = "000" & strCodigoInicial Then

Validar_NIF_CIF_NIE = True

Else

Validar_NIF_CIF_NIE = False

End If

End If

If stEsNumero = True Then

If strDigito = "000" & Codigo & Mid(constLetra, (Codigo Mod 23) + 1, 1) Then

Validar_NIF_CIF_NIE = True

If IsOpen("Mantener_Entidades") Then Form_Mantener_Entidades.txtnif.Value = strDigito

Else

Validar_NIF_CIF_NIE = False

End If

End If

Exit Function

Case 6

strDigito = "00" & Codigo & Mid(constLetra, (("00" & Codigo) Mod 23) + 1, 1)

If stEsLetra = True Then

If strDigito = "00" & strCodigoInicial Then

Validar_NIF_CIF_NIE = True

Else

Validar_NIF_CIF_NIE = False

End If

End If

If stEsNumero = True Then

If strDigito = "00" & Codigo & Mid(constLetra, (Codigo Mod 23) + 1, 1) Then

Validar_NIF_CIF_NIE = True

If IsOpen("Mantener_Entidades") Then Form_Mantener_Entidades.txtnif.Value = strDigito

Else

Validar_NIF_CIF_NIE = False

End If

End If

Exit Function

Case 7

strDigito = "0" & Codigo & Mid(constLetra, (("0" & Codigo) Mod 23) + 1, 1)

If stEsLetra = True Then

If strDigito = "0" & strCodigoInicial Then

Validar_NIF_CIF_NIE = True

Else

Validar_NIF_CIF_NIE = False

End If

End If

If stEsNumero = True Then

If strDigito = "0" & Codigo & Mid(constLetra, (Codigo Mod 23) + 1, 1) Then

Validar_NIF_CIF_NIE = True

If IsOpen("Mantener_Entidades") Then Form_Mantener_Entidades.txtnif.Value = strDigito

Else

Validar_NIF_CIF_NIE = False

End If

End If

Exit Function

Case 8

strDigito = Codigo & Mid(constLetra, (("0" & Codigo) Mod 23) + 1, 1)

If stEsLetra = True Then

If strDigito = strCodigoInicial Then

Validar_NIF_CIF_NIE = True

Else

Validar_NIF_CIF_NIE = False

End If

End If

If stEsNumero = True Then

If strDigito = Codigo & Mid(constLetra, (Codigo Mod 23) + 1, 1) Then

Validar_NIF_CIF_NIE = True

If IsOpen("Mantener_Entidades") Then Form_Mantener_Entidades.txtnif.Value = strDigito

Else

Validar_NIF_CIF_NIE = False

End If

End If

Exit Function

End Select

'End If

End If

Case 9

' averiguamos primero que tipo es mirando por que letra empieza

strPri = UCase(left(Codigo, 1)) 'Guarda letra

strUlt = right(Codigo, 1) 'Guarda dígito de control

' tres opciones : 1ª DNI empiza por nº; 2ª Nie empieza por x,y,z ; 3ª CIF resto letras

Select Case strPri

Case 0, 1, 2, 3, 4, 5, 6, 7, 8, 9

''' es probablemente un dni, comprobamos tambien si el ultimo caracter es un nº, si lo es hay un error, de lo contrario continuamos

If InStr(1, constNumeros, strUlt) <> 0 Then MsgBox " Error en el ultimo caracter del DNI ": Validar_NIF_CIF_NIE = False: Exit Function

MsgBox " Es un DNI"

If Codigo = left(Codigo, Len(Codigo) - 1) & Mid(constLetra, (left(Codigo, Len(Codigo) - 1) Mod 23) + 1, 1) Then

Validar_NIF_CIF_NIE = True

Else

MsgBox " Error en el DNI consultado"

Validar_NIF_CIF_NIE = False

End If

Exit Function

Case "X", "Y", "Z"

MsgBox " Es un NIE"

'comprobamos que el ultimo caracter es una letra, lo que corresponde a un nie

If InStr(1, constNumeros, strUlt) <> 0 Then MsgBox " Error en el ultimo caracter del NIE ": Validar_NIF_CIF_NIE = False: Exit Function

' como es correcto sustituimos las letras por sus valores : [x-0, Y-1,z-2]

' operamos como un dni normal

Select Case strPri

Case "X"

strDigito = "0" & Mid(Codigo, 2, 7)

strDigito = strDigito & Mid(constLetra, (strDigito Mod 23) + 1, 1)

strDigito = "x" & right(strDigito, 8)

If Codigo = strDigito Then Validar_NIF_CIF_NIE = True Else Validar_NIF_CIF_NIE = False

Exit Function

Case "Y"

strDigito = "1" & Mid(Codigo, 2, 7) & strUlt

strDigito = strDigito & Mid(constLetra, (strDigito Mod 23) + 1, 1)

strDigito = "x" & right(strDigito, 8)

If Codigo = strDigito Then Validar_NIF_CIF_NIE = True Else Validar_NIF_CIF_NIE = False

Exit Function

Case "Z"

strDigito = "2" & Mid(Codigo, 2, 7) & strUlt

strDigito = strDigito & Mid(constLetra, (strDigito Mod 23) + 1, 1)

strDigito = "x" & right(strDigito, 8)

If Codigo = strDigito Then Validar_NIF_CIF_NIE = True Else Validar_NIF_CIF_NIE = False

Exit Function

Case Else

MsgBox " Se ha producido un Error indefinido.": Validar_NIF_CIF_NIE = False: Exit Function

End Select

Case "A", "B", "C", "D", "E", "F", "G", "H", "J", "K", "L", "M", "N", "P", "Q", "R", "S", "U", "V", "W"

MsgBox " Es un CIF"

If InStr(1, constNumeros, strUlt) = 0 Then MsgBox " Error en el ultimo caracter del CIF ": Validar_NIF_CIF_NIE = False: Exit Function

strPri = UCase(left(Codigo, 1)) 'Guarda letra

strUlt = right(Codigo, 1) 'Guarda dígito de control

strResto = Mid(Codigo, 2, 7) 'Guarda cuerpo CIF, usado para cálculo

'Suma de posiciones pares

iSuma = CInt(Mid(strResto, 2, 1)) + CInt(Mid(strResto, 4, 1)) + CInt(Mid(strResto, 6, 1))

'Multiplico posiciones impares por dos, y sumo cifras resultantes

strImpares(1) = Format(2 * CInt(Mid(strResto, 1, 1)), "00")

strImpares(2) = Format(2 * CInt(Mid(strResto, 3, 1)), "00")

strImpares(3) = Format(2 * CInt(Mid(strResto, 5, 1)), "00")

strImpares(4) = Format(2 * CInt(Mid(strResto, 7, 1)), "00")

For I = 1 To 4

iSuma = iSuma + (CInt(left(strImpares(I), 1)) + CInt(right(strImpares(I), 1)))

Next I

If Not strPri = "X" And Not strPri = "P" And Not strPri = "S" And Not strPri = "Q" Then

If strUlt = right(CStr(10 - CInt(right(CStr(iSuma), 1))), 1) Then

Validar_NIF_CIF_NIE = True

Else

Validar_NIF_CIF_NIE = False

End If

Else 'Si es organismo oficial o extranjero busco la letra de control:

If strUlt = Chr(64 + (10 - CInt(right(CStr(iSuma), 1)))) Then

Validar_NIF_CIF_NIE = True

Else

Validar_NIF_CIF_NIE = False

End If

End If

Case Else

respuesta = MsgBox("El código introducido no se corresponde ni con un CIF ni con un NIF ni con un NIE, verifíquelo.", vbOKOnly + vbCritical)

Validar_NIF_CIF_NIE = False: Exit Function

End Select

Case Is > 9

respuesta = MsgBox("El código introducido no se corresponde ni con un CIF ni con un NIF, verifíquelo.", vbOKOnly + vbCritical)

Validar_NIF_CIF_NIE = False: Exit Function

End Select

On Error GoTo 0

Exit Function

Validar_NIF_CIF_NIE_Error:

MsgBox "Error " & err.Number & " (" & err.Description & ") in procedure Validar_NIF_CIF_NIE of Módulo checkDigitos", vbCritical, "Balances"

End Function

If Validar_NIF_CIF_NIE(Me.txtnif) Then

MsgBox "NIF/CIF/NIE correcto"

Exit Sub

Else

MsgBox "NIF/CIF/NIE INcorrecto"

DoCmd.RunCommand acCmdUndo

Me.txtnif

Exit Sub

End If

End Sub