VBA Access: Validar NIF/CIF/NIE

A continuación os pongo las funciones necesarias para la validación de NIE,NIF y CIF en Access.

Función isNIFCIFNIE

Esta función es a la que se llama desde un botón o evento para validar el contenido. Identifica si es un NIF;NIE o CIF para validarlo de forma correcta.

Public Function isNIFCIFNIE(DNI As String) As Boolean
Dim cadena As String
 
cadena = left(Trim(DNI), 1)
 
Select Case cadena
 
 Case "B", "A", "J", "H", "Q", "S", "R", "D"
 isNIFCIFNIE = testCIF(DNI)
 
 Case "X", "Y", "Z"
 isNIFCIFNIE = testNIE(DNI)
 
 Case Else
 If IsNumeric(CInt(cadena)) = True Then
  isNIFCIFNIE = testNIF(DNI)
 Else
  MsgBox "NIF/CIF Incorrecto"
 End If
 
End Select
End Function

Función testCIF
Función que valida los NIE.

Public Function testCIF(ByVal valor As String)
 
Dim strLetra As String, strNumero As String, strDigit As String
    Dim strDigitAux As String
    Dim auxNum As Integer
    Dim i As Integer
    Dim suma As Integer
    Dim letras As String
 
    letras = "ABCDEFGHKLMPQSXYZ"
 
    valor = UCase(valor)
 
    If Len(valor) < 9 Or Not IsNumeric(Mid(valor, 2, 7)) Then
        testCIF = False
        Exit Function
    End If
 
    strLetra = Mid(valor, 1, 1)     ' letra del CIF
    strNumero = Mid(valor, 2, 7)    ' Codigo de Control
    strDigit = Mid(valor, 9)        ' CIF menos primera y ultima posiciones

    If InStr(letras, strLetra) = 0 Then ' comprobamos la letra del CIF (1ª posicion)
        testCIF = False
    End If
 
    For i = 1 To 7
        If i Mod 2 = 0 Then
            suma = suma + CInt(Mid(strNumero, i, 1))
        Else
            auxNum = CInt(Mid(strNumero, i, 1)) * 2
            suma = suma + (auxNum \ 10) + (auxNum Mod 10)
        End If
    Next
 
    suma = (10 - (suma Mod 10)) Mod 10
 
    Select Case strLetra
        Case "K", "P", "Q", "S"
            suma = suma + 64
            strDigitAux = Chr(suma)
        Case "X"
            strNumero = Mid(valor, 1, 8)
            strNumero = Replace(strNumero, "X", 0)
            strDigitAux = Mid(CalcularLetra(strNumero), 9, 1)
'        Case "Y"
'            strNumero = Mid(valor, 1, 8)
'            strNumero = Replace(strNumero, "Y", 1)
'            strDigitAux = Mid(CalculaNIF(strNumero), 9, 1)
'        Case "Z"
'            strNumero = Mid(valor, 1, 8)
'            strNumero = Replace(strNumero, "Z", 2)
'            strDigitAux = Mid(CalculaNIF(strNumero), 9, 1)
        Case Else
            strDigitAux = CStr(suma)
    End Select
 
    If strDigit = strDigitAux Then
        testCIF = True
    Else
        testCIF = False
    End If
 
End Function

Función CalcularLetra
Función a la que llama testNIF para calcular la letra del final.

Public Function CalcularLetra(ByVal stra As String) As String
 
Const cCADENA As String = "TRWAGMYFPDXBNJZSQVHLCKET"
    Const cNUMEROS As String = "0123456789"
    Dim a, b, c, i As Integer
    Dim NIF As Long
    Dim sb As New StringBuilder
 
    stra = Trim(stra)
    If Len(stra) = 0 Then
        CalcularLetra = ""
    End If
    ' Dejar sólo los números
    For i = 0 To Len(stra) - 1
        If InStr(stra, cNUMEROS) > -1 Then
            sb.Append (stra)
        End If
    Next
 
    stra = CStr(stra)
    a = 0
    NIF = CLng(stra)
 
    Do
        b = CLng(Int(NIF / 24))
        c = NIF - (24 * b)
        a = a + c
        NIF = b
    Loop While b <> 0
    b = CLng(Int(a / 23))
    c = a - (23 * b)
 
    CalcularLetra = stra & Mid(cCADENA, CInt(c + 1), 1)
 
End Function

Clase StringBuilder

El siguiente código debe guardarse como un Módulo de clase.

Option Compare Database
 
' Class: StringBuilder

Option Explicit
 
Private Const initialLength As Long = 32
 
Private totalLength As Long  ' Length of the buffer
Private curLength As Long    ' Length of the string value within the buffer
Private buffer As String     ' The buffer

Private Sub Class_Initialize()
  ' We set the buffer up to it's initial size and the string value ""
  totalLength = initialLength
  buffer = Space(totalLength)
  curLength = 0
End Sub
 
Public Sub Append(Text As String)
 
  Dim incLen As Long ' The length that the value will be increased by
  Dim newLen As Long ' The length of the value after being appended
  incLen = Len(Text)
  newLen = curLength + incLen
 
  ' Will the new value fit in the remaining free space within the current buffer
  If newLen <= totalLength Then
    ' Buffer has room so just insert the new value
    Mid(buffer, curLength + 1, incLen) = Text
  Else
    ' Buffer does not have enough room so
    ' first calculate the new buffer size by doubling until its big enough
    ' then build the new buffer
    While totalLength < newLen
      totalLength = totalLength + totalLength
    Wend
    buffer = left(buffer, curLength) & Text & Space(totalLength - newLen)
  End If
  curLength = newLen
End Sub
 
Public Property Get Length() As Integer
  Length = curLength
End Property
 
Public Property Get Text() As String
  Text = left(buffer, curLength)
End Property
 
Public Sub Clear()
  totalLength = initialLength
  buffer = Space(totalLength)
  curLength = 0
End Sub

Microsoft Access: Poner contraseña a la base de datos

A continuación os expongo los pasos a seguir para poner una contraseña de acceso a las base de datos access.

1- Abrimos Microsoft Access
2- Damos a Archivo -> Abrir

access_abrir_bd
3- Buscamos la base de datos a la que queremos poner la contraseña. Antes de darle a abrir, hay que dar al lado del botón a abrir. Elegir Abrir en modo exclusivo.

access_abrir_modo_exclusivo
4- Damos a Archivo y seleccionamos “Cifrar con contraseña”.

access_elegir_poner_contraseña

5- Ponemos la contraseña deseada

access_poner_contraseña

Servidor VPS gratis de por vida

¿Que es un VPS?

Un servidor virtual privado (VPS, del inglés virtual private server) es un método de particionar un servidor físico en varios servidores de tal forma que todo funcione como si se estuviese ejecutando en una única máquina. Cada servidor virtual es capaz de funcionar bajo su propio sistema operativo y además cada servidor puede ser reiniciado de forma independiente.La práctica de particionar un único servidor para que funcione en varios servidores ya comenzó con los mainframes y ha vuelto a resurgir con el desarrollo de la virtualización y las tecnologías para otras arquitecturas.Mientras un VPS funciona con su propia copia del sistema operativo, los clientes tienen nivel de acceso de root o superusuario y por tanto, pueden instalar cualquier tipo de software, que posteriormente pueda ser ejecutado bajo su sistema operativo. Algunos programas no ejecutan bien en entornos virtuales, incluyendo firewalls, clientes anti-virus e incluso otras herramientas virtuales; algunos VPS proveen fuertes restricciones, pero generalmente son laxas comparadas con las que existen en los servidores de almacenamiento compartido. Debido a que varios clientes (virtuales) pueden trabajar sobre una sola máquina, un VPS normalmente tiene ciertas limitaciones en cuanto al tiempo de procesamiento, RAM y espacio en el disco.

Fuente | Wikipedia

¿Quieres conseguir un VPS gratis?

Apúntate haciendo clic aquí y entra en al lista para conseguir uno gratis.

 

Chronoshare – Web para contratar o ser contratado para hacer determinadas tareas

Hoy os vengo a contar mi experiencia con chronoshare. Puedo decir que he experimentado la utilización de este portal desde ambos lados.

HE CONTRATADO: He contratado una persona para temas de limpieza. Y el resultado ha sido satisfactorio.
HE PODIDO SER CONTRATADO: Digo he podido, porque la experiencia desde esta posición no ha sido nada satisfactoria.

La experiencia de contratar no la cuento porque es lo mas similar a otros portales existentes en el mercado. Tu pones un anuncio, la gente te contacta para ofrecerte tus servicios. Y decides a quien elegir. Lo único malo ,por decirlo de alguna manera, es que como pones el teléfono puedes recibir una cuantas llamadas muy seguidas, donde la gente son a veces muy pelmas. Pero luego entiendes que es normal cuando te pones desde el lado de ellos.

¿HE PODIDO SER CONTRATADO?

El funcionamiento se basa en créditos (Chronos). Para conseguir los datos de contacto deuna oferta tienes que tener crédito. Depende la oferta te cuesta una cantidad diferente de créditos, pero puede ser unos 3€ por decir un importe.
Una vez conseguidos los datos de contacto puedes ya ponerte en comunicación con la persona para ofrecerle tus servicios.
Posteriormente la persona elige a la persona, y he aquí cuando viene el kit de la cuestión.

No comunica directamente en el portal que ya ha elegido a alguien, con lo cual tienes que estar pendiente para volver a ponerte en contacto para saber que ha pasado. El portal manda correos a la persona como esta la situación de la oferta, pero puede ignorarlos.

¿Y que pasa sino he sido elegido?

Puedes pedir la devolución. Pero no te van a devolver todo, sino solo una parte. Lo cual es bastante frustante, y no puedas apuntarte a muchas ofertas, porque sino se te acaban los créditos enseguida. La verdad que no me convence el sistema. Pensaría mas justo que te quiten una parte de lo cobrado o algo así, pero este sistema me parece que tiras bastante el dinero.

Añadir referencias vba access de forma dinámica

Me he encontrado en la situación que tengo una aplicación de access montada de forma cliente/servidor. Cuando por alguna razón tengo que crear un Access donde vuelva a unir tanto las tablas como los formularios las referencias a las librerias ya no estas puestas y hay que ir añadiendo una a una. A continuación os cuento un módulo que tengo creado para que mediante una función me vuelva a poner todas las referencias.

Función que me sirve para saber que librerías tengo activadas para crear la función:

Public Function PrintOutCurrentReferences()
Dim iIndex As Integer

For iIndex = 1 To Application.References.Count
Debug.Print Application.References(iIndex).Name _
& ", " & Application.References(iIndex).GUID _
& ", " & Application.References(iIndex).Major _
& ", " & Application.References(iIndex).Minor
Next
End Function

Función para definir las referencias que quiero activar:

Public Sub Referencias()
'Add VBA
If (AddReference("VBA", "{000204EF-0000-0000-C000-000000000046}", 4, 1) = False) Then
   If (AddReference("VBA", "{000204EF-0000-0000-C000-000000000046}", 4, 1) = False) Then
        Call AddReference("VBA", "{000204EF-0000-0000-C000-000000000046}", 4, 1)
   End If
End If
End Sub

Sería un bloque por cada referencia que quiera activar.

Función que añade las referencias:

Private Function AddReference(sReferenceName As String, sReferenceGUID As String, iMajorVersion As Integer, iMinorVersion As Integer) As Boolean
Dim bFound As Boolean
Dim iIndex As Integer

bFound = False
'Try to find an existing reference
For iIndex = 1 To Application.References.Count
If Application.References(iIndex).Name = sReferenceName Then
bFound = True
'Remove the reference if it is broken
If Application.References(iIndex).IsBroken Then
Application.References.Remove Application.References(iIndex)
bFound = False
End If
Exit For
End If
Next

'If the reference was not found, or it was broken, add it
If bFound = False Then
On Error Resume Next
Application.References.AddFromGuid sReferenceGUID, iMajorVersion, iMinorVersion
If err.Number = 0 Then
bFound = True
Else
err.Clear
End If
End If

AddReference = bFound
End Function

Livingo – Plataforma comercial online de muebles y artículos de decoración

Me encuentro en un momento decisivo de mi vida, me he comprado casa la cual me están construyendo. Y una de mis primeras tareas es empezar a mirar que muebles pongo en ella. Lo típico es mirar las cadenas de tiendas existentes en los parques/centros comerciales que todos conocemos y que están presentes en todas las ciudades. De esta forma, estamos desaprovechando el gran potencial que nos ofrece internet en cuestión de comprar muebles o elementos de decoración para nuestro hogar.

Entre las opciones que tenemos disponibles hay  una me que me ha llamado mucho la atención… LIVINGO. Livingo es una plataforma comercial online, que funciona como centro de intermediación para marcas representativas del mercado.

La página está estructurada de forma muy inteligente por categorías y subcategorías. Además permite filtrar los productos de múltiples maneras como por ejemplo Color, Material, Marca…

Livingo nos agrupa productos de diferentes tiendas/webs, lo que nos va a permitir ahorrar tiempo en la búsqueda y comparación de productos para nuestro hogar. De cada producto nos ofrece una información mínima que nos servirá para poder filtrarlos y buscarlos de forma más eficiente. Cuando nos interese alguno desde el propio producto podremos ir a la tienda que lo vende con un solo clic, fácil y sencillo.

Una función muy interesante es que podemos marcar nuestros productos como favoritos para poder recuperarlos posteriormente de una manera sencilla. Así no tendremos que volver a buscarlos.

La verdad que no os puedo más que recomendar que os deis una vuelta por Livingo y disfruta buscando el mueble o artículo de decoración ideal para tu hogar.

Sitio Web | Livingo