Military Time

[speakers_86]

Use it if you need. Credit is appreciated.

Public Function MilitaryTime(Optional dtedate As Variant) As String
If IsMissing(dtedate) Then dtedate = Now
If IsNull(dtedate) Then dtedate = Now
Dim a As String
a = DatePart("m", dtedate)
Dim b As String
b = DatePart("d", dtedate)
Dim c As String
c = DatePart("yyyy", dtedate)
Dim d As String
d = DatePart("h", dtedate)
Dim e As String
e = DatePart("n", dtedate)
MilitaryTime = a & "/" & b & "/" & c & " " & d & e
End Function

Public Function Convert2Date(Optional dtedate As Variant) As Date
Dim dte As String
dte = MilitaryTime(dtedate)
Dim strLeft As String
strLeft = Mid(dte, 1, 13)
Dim strRight As String
strRight = Mid(dte, 14, 2)
MsgBox strLeft & strRight
Convert2Date = CDate(strLeft & ":" & strRight)
End Function

 

[boblarson]

Unless I'm missing something, you could just format it:

For Military Date/Time:

Format(Now(), "m/d/yyyy hh:nn")
?Format(Now(), "m/d/yyyy hh:nn") would yield for me right now at 2:29 PM on 13-Dec-2011
12/13/2011 14:29


or for am/pm

Format(Now(), "m/d/yyyy h:nn AM/PM")
?Format(Now(), "m/d/yyyy h:nn AM/PM") would yield for me right now at 2:29 PM on 13-Dec-2011
12/13/2011 2:29 PM

 

[speakers_86]

Of course you can, but one way or another I was struggling presenting data the way I wanted it presented. Also, I started using a calendar pop up form, that does not have anything about time. Since we have CDate, why bother? Only with dates I actually need to manipulate, I am storing the date as text with a field size of 10, and time as number with a field size of 4. The format of the time field is 0000.

Here is an upgrade to the above.

'Example
'Print MilitaryTime
'12/11/2011 2312
'Print MilitaryTime(, True)
'2313
'Print MilitaryTime("12/14/2001 23:32")
'12/14/2001 2332
'Print MilitaryTime("12/14/2001 1:23")
'12/14/2001 0123
'Print MilitaryTime("12/14/2001 23:32", True)
'2332
'Print MilitaryTime("12/14/2001 1:23", True)
'123
'Print MilitaryTime("12/21/2001 1:09 pm")
'12/21/2001 1309

Public Function MilTime(Optional dteDate As Variant, Optional booTime As Variant, Optional booDate As Variant) As String
    If IsMissing(dteDate) Then dteDate = Now
    If IsNull(dteDate) Then dteDate = Now
    If IsMissing(booTime) Then booTime = False
    If IsMissing(booDate) Then booDate = False
    Dim a As String
    a = DatePart("m", dteDate)
    If Len(a) = 1 Then a = "0" & a
    Dim b As String
    b = DatePart("d", dteDate)
    If Len(b) = 1 Then b = "0" & b
    Dim c As String
    c = DatePart("yyyy", dteDate)
    Dim d As String
    d = DatePart("h", dteDate)
    If Len(d) = 1 Then d = "0" & d
    Dim e As String
    e = DatePart("n", dteDate)
    If Len(e) = 1 Then e = "0" & e
    If booTime = True Then
        MilTime = d & e
    Else
        If booDate = True Then
            MilTime = a & "/" & b & "/" & c
        Else
            MilTime = a & "/" & b & "/" & c & " " & d & e
        End If
    End If
End Function




'Example
'Print Convert2Date("12/11/2011 2312")
'12/11/2011 11:12:00 PM
'Print Convert2Date("2312", True)
'11:12:00 PM
'Print Convert2Date("12/14/2001 2332")
'12/14/2001 11:32:00 PM
'Print Convert2Date("12/14/2001 0123")
'12/14/2001 1:23:00 AM
'Print Convert2Date("12/14/2001 0123", True)
'12:23:00 PM
'Print Convert2Date("12/14/2001 1734", True)
'5:34:00 PM
'Print Convert2Date("1724", True)
'5:24:00 PM
'now your can perform date functions like dateadd
Public Function Convert2Date(dteDate As String, Optional booTime As Boolean) As Date
    If IsMissing(booTime) Then booTime = True
    Dim strLeft As String
    Dim strRight As String
    If booTime = False Then
        strLeft = Mid(dteDate, 1, 13)
        Convert2Date = CDate(strLeft)
    Else
        Dim a As String
        a = right(dteDate, 4)
        strLeft = Left(a, 2)
        strRight = right(dteDate, 2)
        Convert2Date = CDate(strLeft & ":" & strRight)
    End If
End Function

Here is a sub that verifies if the user entered an appropriate time. It must go in your form unless you rework the me our of it.

Public Sub VerifyTime()
    If Me.ActiveControl > 2400 Then GoTo error
    If right(Me.ActiveControl, 2) >= 60 Then GoTo error
    If Me.ActiveControl < 0 Then GoTo error
    If Len(Me.ActiveControl) > 4 Then GoTo error
    Exit Sub
error:
    MsgBox "Please enter an appropriate military time.", , "Error"
    Me.ActiveControl = Null
    Me.ActiveControl.SetFocus
End Sub

 

[vbaInet]

Am I missing something too? Can't you just:

format(now(), "mm/dd/yyyy hhnn")