How to round oMail.ReceivedTime to nearest minute?

Question

I've a VBA macro that will save an email with the file name "yymmdd.hhmm.[Sender].[Recipient].[Subject Line].txt" that works almost the way I want.

The issue is that the time displayed in Outlook (and the files that are saved) will round the received time to the nearest minute. Outlook will take the received time from the header, but if an email is received at 30-59 seconds past the minute, it will “round up” to the next minute. So an email received at 15:00:30 will display in Outlook (and my saved txt file) as 3:01pm.
The generated file name, however, will display the "hhmm" as "1500"

This discrepancy is causing issues because it looks like times are being altered.

How do I either get my macro to round to the nearest minute, or get Outlook to not round up the displayed time?

Option Explicit
Public Sub SaveMessageAsTxt()
 Dim oMail As Outlook.MailItem
 Dim objItem As Object
 Dim sPath As String
 Dim dtDate As Date
 Dim sName As String
 Dim enviro As String
 enviro = CStr(Environ("USERPROFILE"))
 For Each objItem In ActiveExplorer.Selection
 If objItem.MessageClass = "IPM.Note" Then
 Set oMail = objItem
sName = oMail.SenderName & "." & oMail.Recipients(1) & "." & oMail.Subject
 ReplaceCharsForFileName sName, ""
dtDate = oMail.ReceivedTime
 sName = Format(dtDate, "yymmdd.", vbUseSystemDayOfWeek, _
 vbUseSystem) & Format(dtDate, "hhnn", _
 vbUseSystemDayOfWeek, vbUseSystem) & "." & sName & ".txt"
sPath = enviro & "\Documents\Saved Emails\"
 Debug.Print sPath & sName
 oMail.SaveAs sPath & sName, olTXT
End If
 Next
End Sub


Private Sub ReplaceCharsForFileName(sName As String, sChr As String)
 sName = Replace(sName, "'", sChr)
 sName = Replace(sName, "*", sChr)
 sName = Replace(sName, "/", sChr)
 sName = Replace(sName, "\", sChr)
 sName = Replace(sName, ":", sChr)
 sName = Replace(sName, "?", sChr)
 sName = Replace(sName, Chr(34), sChr)
 sName = Replace(sName, "<", sChr)
 sName = Replace(sName, ">", sChr)
 sName = Replace(sName, "|", sChr)
End Sub

Answer 1

Manually round the date?

Dim intSeconds As Integer
intSeconds = Second(dtDate)
If intSeconds > 29 Then
    dtDate = DateAdd("s", 60 - intSeconds, dtDate)
End If