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