VBA Access: Obtener fecha de cumpleaños y mostrar mensaje
Dado que tengo la fecha de nacimiento de una persona, al consultar datos de esta persona de diferentes maneras, necesito obtener un mensaje que me indique cuánto falta para su cumpleaños desde una semana de anticipación ("Faltan X días para el cumpleaños de Y" o bien "Hoy cumple X años").
Intenté armar la fecha de su próximo cumpleaños mediante Day y Month pero por algún motivo no me da correcta la fecha (por ejemplo, la fecha de cumpleaños es 18/11/2016 y me la arma como 30/12/2016).
Public Sub CUMPLEANOS()
Dim DIANAC As Integer, MESNAC As Integer, CUMPLE As Date, FECHA As Date, vT As String, vFNac As Date, vNom As String
On Error GoTo ERRH
' Establecela fecha de defunción
vFNac = DLookup("[FNAC]", "[LECTOR]", "[DNI] = " & VCONSULTA & "")
vNom = DLookup("[NOM]", "[LECTOR]", "[DNI] = " & VCONSULTA & "")
vNom = vNom & " " & DLookup("[APE]", "[LECTOR]", "[DNI] = " & VCONSULTA & "")
RETOMAR:
' Establece día y mes del cumpleaños
DIANAC = Day(vFNac)
MESNAC = Month(vFNac)
' Establece cumpleaños
MsgBox "Día: " & DIANAC & vbLf & "Mes: " & MESNAC & vbLf & "FNac: " & vFNac
CUMPLE = DateSerial(Year(Now()), MESNAC, DIANAC)
FECHA = Format(Now(), "dd/mm/yyyy")
MsgBox "Fecha: " & FECHA & vbLf & "Cumple: " & CUMPLE
' If CUMPLE = (FECHA + 7) Then
' vT = "en 1 semana"
' ElseIf CUMPLE = (FECHA + 2) Then
' vT = "pasado mañana"
' ElseIf CUMPLE = (FECHA + 1) Then
' vT = "mañana!"
' ElseIf CUMPLE <= (FECHA + 6) Then
' vT = "en " & (FECHA + 6) - Date & " días"
' ElseIf CUMPLE = FECHA Then
' MsgBox "¡" & vNom & " cumple " & Int((CUMPLE - vFNac) / 365) & " años del día de hoy!", 48, "Cumpleaños del Lector"
'' ElseIf CUMPLE > FECHA Then
'' vT = "este mes: el " & CUMPLE
' End If
' If FECHA < CUMPLE Then
' MsgBox "¡" & vNom & " cumple años " & vT & "!", 48, "Cumpleaños del Lector"
' End If
'-------- FIN CONTROL DE CUMPLEAÑOS --------
EXITH:
Exit Sub
ERRH:
If Err.Number = 2471 Then
MsgBox "No se ha logrado obtener la fecha de cumpleaños del lector." & vbLf & _
"Error: " & Err.Number & ". " & Error$ & ".", 16, "Error " & Err.Number
ElseIf Err.Number = 94 Or Err.Number = 0 Then
vFNac = vFECHANACIMIENTO
vNom = vNOMBRE & " " & vAPELLIDO
GoTo RETOMAR
Else
ENTORNOERR = "Calculos.CUMPLEANOS"
Mensajes.ERR_GENERAL_BY_N
End If
End SubEl código que hice lo intento corregir al darme cuenta que no me da bien los datos, pero habrá parte comentada o MsgBox con el fin de controlar valores. No logro dar pie con bola.
Sasha: Quizá cambia algo el código, pero el proceso completo, incluyendo el aviso, lo tienes en éste enlace, que corresponde a un ejemplo que tengo en Mediafire.
http://www.mediafire.com/file/qnhscyte3eqoedd/AvisosCumple.rar
Mis saludos >> Jacinto
¡Gracias!
Veo que no se publicó en aquél momento mi respuesta, pero de todos modos lo hago ahora: eso que me pasas no es lo que necesito pero lo he podido aplicar en otra cosa diferente y me ha sido de muchísima ayuda.
De todos modos, revisé el código y con todo lo aprendido hasta el momento logré mejorarlo y así quedó:
Public Sub CUMPLEANOS()
Dim vFNac As Date, vDiaNac As Byte, vMesNac As Byte, vCumple As Date, vDif As Long, VAPENOM As String, vHoy As Date, vMge As String
On Error GoTo ERRH
vFNac = DLookup("[FNAC]", "[LECTOR]", "[DNI] = " & VCONSULTA & "")
VAPENOM = DLookup("[NOM]", "[LECTOR]", "[DNI] = " & VCONSULTA & "")
VAPENOM = VAPENOM & " " & DLookup("[APE]", "[LECTOR]", "[DNI] = " & VCONSULTA & "")
RETOMAR:
vDiaNac = Day(vFNac)
vMesNac = Month(vFNac)
vCumple = CDate(vDiaNac & "/" & vMesNac & "/" & Year(Date))
vHoy = CDate(Date)
vDif = vCumple - vHoy
Select Case vDif
Case 3 To 7
vMge = "en " & vDif & " días!"
Case 2
vMge = "pasado mañana!"
Case 1
vMge = "mañana!"
Case 0
vMge = "hoy!"
Case Else
vMge = "N/A " & vDif
End Select
Select Case vDif
Case 0 To 7
MsgBox "¡" & VAPENOM & " cumple años " & vMge, 32, "Cumpleaños de " & VAPENOM
End Select
EXITH:
Exit Sub
ERRH:
If Err.Number = 2471 Then
MsgBox "No se ha logrado obtener la fecha de cumpleaños del lector." & vbLf & _
"Error: " & Err.Number & ". " & Error$ & ".", 16, "Error " & Err.Number
ElseIf Err.Number = 94 Or Err.Number = 0 Then
vFNac = CDate(vFECHANACIMIENTO)
VAPENOM = vNOMBRE & " " & vAPELLIDO
GoTo RETOMAR
Else
ENTORNOERR = "Calculos.CUMPLEANOS"
Mensajes.ERR_GENERAL_BY_N
End If
End SubCon eso me avisa dentro de la semana anterior sobre el cumpleaños de X persona.
