Date of maturity

[azhar2006]

Hello All
I have a table that contains dates of childhood vaccines, there is a field in the table name (BCG) of type Date, the date of the first dose of the vaccine.
What I want is.
Field on the Form calculates the month and two days from the date of the first dose and shows me the date of the next or second dose.

I have used this code


= DateAdd ('m', 1, [bcg])
But show me a month difference does not appear to me days difference
I want a month and two days

Thanks in advance

[ranman256]

try this...put this function into a module.
the parameter....(time difference)... must be given in seconds...
usage: ElapsedTimeAsTextRecur (datediff("s",[bcg],date()))

'USAGE:  ElapsedTimeAsTextRecur(655)
Public Function ElapsedTimeAsTextRecur(ByVal pvSecs, Optional ByVal pvSecBlock)
'recursive time lapse given seconds
Dim vTxt
Dim iNum As Long
Const kDAY = 86400
Const kSECpYR = 31536000


'60 sec = 1 min             60 sec
'60 min = 1 hr            3600 sec
'24 hr = 1 day           86400 sec
'7 days = 1 week        604800 sec
'30 days = 1 month     2592000
'12 months = 1 year = 31536000


'YEARS
If IsMissing(pvSecBlock) Then pvSecBlock = kSECpYR
iNum = pvSecs \ pvSecBlock
    
    Select Case pvSecBlock
       Case kSECpYR   'yr
          sUnit = "years"
          If iNum > 0 Then
               vTxt = iNum & " years "
               pvSecs = pvSecs - (iNum * pvSecBlock)
          End If
          vTxt = vTxt & ElapsedTimeAsTextRecur(pvSecs, 2592000)
          
      Case 2592000    'MO
          sUnit = "months"
          If iNum > 0 Then
               If iNum > 11 Then iNum = 11
               vTxt = vTxt & iNum & " months "
               pvSecs = pvSecs - (iNum * pvSecBlock)
          End If
          vTxt = vTxt & ElapsedTimeAsTextRecur(pvSecs, 604800)
       
       Case 604800     'WEEK
          sUnit = "weeks"
          If iNum > 0 Then
               If iNum > 3 Then iNum = 3
               vTxt = vTxt & iNum & " weeks "
               pvSecs = pvSecs - (iNum * kDAY * 7)
          End If
          vTxt = vTxt & ElapsedTimeAsTextRecur(pvSecs, 86400)
       
       Case kDAY      'day
          sUnit = "days"
          If iNum > 0 Then
               vTxt = vTxt & iNum & " days "
               pvSecs = pvSecs - (iNum * kDAY)
          End If
          vTxt = vTxt & ElapsedTimeAsTextRecur(pvSecs, 3600)
       
       Case 3600       'hrs
          sUnit = "hrs"
          If iNum > 23 Then iNum = 23
          If iNum > 0 Then
               vTxt = vTxt & iNum & " hrs "
               pvSecs = pvSecs - (iNum * pvSecBlock)
          End If
          vTxt = vTxt & ElapsedTimeAsTextRecur(pvSecs, 60)
       
       Case 60         'min
          sUnit = "mins"
          If iNum > 0 Then
               vTxt = vTxt & iNum & " mins "
               pvSecs = pvSecs - (iNum * pvSecBlock)
          End If
          vTxt = vTxt & ElapsedTimeAsTextRecur(pvSecs, 1)
       
       Case Else
          
          sUnit = "secs"
          If pvSecs > 0 Then vTxt = vTxt & pvSecs & " seconds"
    End Select
    
ElapsedTimeAsTextRecur = vTxt
End Function

[orange]

This should do the job

Function Vaccination2(FirstShot As Date) As Date

    Dim Vaccination1 As Date
   On Error GoTo Vaccination2_Error

    Vaccination1 = FirstShot
    Dim shot2 As Date
    shot2 = DateAdd("m", 1, Vaccination1)
    shot2 = DateAdd("d", 2, Vaccination1)
    Vaccination2 = shot2
    'Debug.Print Vaccination2

   On Error GoTo 0
   Exit Function

Vaccination2_Error:

    MsgBox "Error " & Err.number & " (" & Err.Description & ") in procedure Vaccination2 of Module AWF_Related"
End Function

[azhar2006]

Thanks very much orange
Thanks very much ranman256
He has worked very well, thank you orange for help me