Option Compare Database
Function date_diff(oldd As Date, newd As Date) As String
Dim years, months, days As Integer
years = Year(newd) - Year(oldd)
If Month(newd) < Month(oldd) Then
years = years - 1
months = (Month(newd) + 12) - Month(oldd)
Else
months = Month(newd) - Month(oldd)
End If
If Day(newd) < Day(oldd) Then
months = months - 1
days = (Day(newd) + 30) - Day(oldd)
Else
days = Day(newd) - Day(oldd)
End If
date_diff = Format(years, "00") & " years " & Format(months, "00") & " months " & Format(days, "00") & " days"
End Function
Function add_diffs(ParamArray strDiffs() As Variant) As String
Dim yy, mm, dd, years, months, days As Integer
Dim dif As Variant
For Each dif In strDiffs()
'dif = CStr(dif)
yy = IIf(Left("" & dif & "", 1) = "-", GetNumber("" & dif & "", 0) * -1, GetNumber("" & dif & "", 0))
mm = IIf(Left("" & dif & "", 1) = "-", GetNumber("" & dif & "", 1) * -1, GetNumber("" & dif & "", 1))
dd = IIf(Left("" & dif & "", 1) = "-", GetNumber("" & dif & "", 2) * -1, GetNumber("" & dif & "", 2))
years = years + yy
If (months + mm) > 12 Then
years = years + ((months + mm) \ 12)
months = (months + mm) Mod 12
ElseIf (months + mm) < 0 Then
years = years - 1
months = months + mm + 12
Else
months = months + mm
End If
If (days + dd) > 30 Then
months = months + ((days + dd) \ 30)
days = (days + dd) Mod 30
ElseIf (days + dd) < 0 Then
months = months - 1
days = days + dd + 30
Else
days = days + dd
End If
Next
add_diffs = Format(years, "00") & " years " & Format(months, "00") & " months " & Format(days, "00") & " days"
End Function
Function GetNumber(str As String, n As Integer) As Integer
Set regex = CreateObject("vbscript.regexp")
regex.Global = True
regex.Pattern = "\d{2}"
GetNumber = regex.Execute(str)(n)
End Function
Function empDsum(fld As String) As String
Dim rst As New ADODB.Recordset, cnn As ADODB.Connection, difs As Variant
Set cnn = CurrentProject.Connection
strQuery = "SELECT empname, startdt, enddt, IIf(worktype=2, ""-"" & date_diff([startdt],[enddt]), date_diff([startdt],[enddt])) AS addif FROM tbl1 WHERE empname=" & fld & ";"
rst.Open strQuery, cnn
Do While Not rst.EOF
difs = difs & """" & rst![addif] & """, "
rst.MoveNext
Loop
Set rst = Nothing
Set cnn = Nothing
'Debug.Print Left(difs, Len(difs) - 2)
empDsum = "" & Left(difs, Len(difs) - 2) & ""
'empDsum = add_diffs(Left(difs, Len(difs) - 2))
End Function
Sub test()
Debug.Print add_diffs(empDsum("1"))
Debug.Print add_diffs("07 years 07 months 10 days", "-01 years 00 months 00 days", "-00 years 08 months 28 days", "01 years 03 months 24 days")
End Sub