Calculate time to a deadline

[Rob Kuijpers]

First:
Somehow I couldn't reply on the messages due to "Unable to retrieve
message (e-mail address removed)", so that's maybe
why it's not in the thread...

Ok, Thanks very much Helmut, that did the trick. Only weekday had to
be 3 (for a wednesday when the first day of the week is monday -
vbMonday), but that is forgiven of course ;-).

I figured out how to calculate the remaining time (thanks to you again
on another forum), so the code is now like this (the deadline of a
magazine is every wednesday at 10 am):
(For those who are not that familiar with forms: txtWeekNr,
txtDueDateMag and txtDeadline are textboxes in a form)

****in the form - just a piece of it****
Dim DStr, WStr As Date
If Format(Date, "dddd") = "thursday" Then Plus = 8
If Format(Date, "dddd") = "friday" Then Plus = 7
If Format(Date, "dddd") = "saturday" Then Plus = 6
If Format(Date, "dddd") = "sunday" Then Plus = 5
If Format(Date, "dddd") = "monday" Then Plus = 4
If Format(Date, "dddd") = "tuesday" Then Plus = 3
If Format(Date, "dddd") = "wednesday" Then
If Format(Time, "hh:mm") > "10:00" Then
Plus = 9
Else
Plus = 2
End If
End If

DStr = Format(Date + Plus, "dddd d mmmm yyyy")
WStr = Format(Date + Plus, "dd-mm-yyyy")
txtWeekNr = Format(WStr, "ww", vbMonday, vbFirstFourDays)
txtDueDateMag = DStr + " = week " + txtWeekNr.Value

Dim dDat As Date
dDat = Date
If Weekday(Date, vbMonday) = 3 And _
Timer < 36000 Then ' it's before 10 o'clock on wednesday
MsgBox "Be reminded that the deadline is at 10 am today!", _
vbInformation + vbOKOnly, "Reminder"
End If
While Weekday(dDat, vbMonday) <> 3
dDat = dDat + 1
Wend
If Weekday(dDat, vbMonday) = 3 And _
Timer > 36000 Then
dDat = dDat + 7
End If
dDat = dDat & " 10:00:00"
DeadDiff = DateDiff("s", Now, dDat)
txtDeadline = "The deadline is in " & FormatTime(DeadDiff) & " !"
*******

Using your Functions:
Public Sub ParseTime(TotalSecs As Long, Days As Long, Hours As Long, _
Mins As Long, Secs As Long, mode As Boolean)
' mode = True = from seconds to days, hours, min
' mode = False = from days, hours, mins to total seconds

Dim worktime As Long

If mode = True Then ' from seconds to days, hours, min
worktime = TotalSecs
Days = worktime \ 86400
worktime = worktime - (Days * 86400)
Hours = worktime \ 3600
worktime = worktime - (CLng(Hours) * 3600)
Mins = worktime \ 60
worktime = worktime - (CLng(Mins) * 60)
Secs = worktime
Else ' from days, hours, mins to total seconds
TotalSecs = Days * 86400
TotalSecs = TotalSecs + (Hours * 3600)
TotalSecs = TotalSecs + (Mins * 60)
TotalSecs = TotalSecs + Secs
End If

End Sub

Public Function FormatTime(ByVal lSeconds As Long) As String

Dim Days As Long
Dim Hours As Long
Dim Minutes As Long
Dim Seconds As Long
Dim tmp As String

ParseTime lSeconds, Days, Hours, Minutes, Seconds, True

If Days > 0 Then tmp = Days & " " & IIf(Days > 1, "days, ", "day, ")

If Hours > 0 Then tmp = tmp & _
IIf(Len(tmp) > 0, ", ", "") & Hours & " " & IIf(Hours > 1, "hours and
", "hour and ")

If Minutes > 0 Then tmp = tmp & _
IIf(Len(tmp) > 0, "", "") & Minutes & " " & IIf(Minutes > 1,
"minutes", "minute")

'If Seconds > 0 Then tmp = tmp & _
'IIf(Len(tmp) > 0, ", ", "") & Seconds & " " & IIf(Seconds > 1,
"Seconds", "Second")

FormatTime = tmp

End Function