如何将 oMail.ReceivedTime 四舍五入到最近的分钟数？

Question

我有一个 VBA 宏，可以保存文件名为“yymmdd.hhmm.[发件人].[收件人].[主题行].txt”的电子邮件，几乎可以正常工作我想要的方式。

问题是 Outlook 中显示的时间（以及保存的文件）会将接收到的时间四舍五入到最接近的分钟。 Outlook 将从 header 开始接收时间，但如果在一分钟后 30-59 秒收到一封电子邮件，它将“四舍五入”到下一分钟。因此，在 15:00:30 收到的电子邮件将在 Outlook（和我保存的 txt 文件）中显示为 3:01pm。
但是，生成的文件名会将“hhmm”显示为“1500”

这种差异导致了问题，因为看起来时间正在被更改。

如何让我的宏四舍五入到最接近的分钟，或者让 Outlook 不四舍五入显示的时间？

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

手动舍入日期？

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

如何将 oMail.ReceivedTime 四舍五入到最近的分钟数？

How to round oMail.ReceivedTime to nearest minute?

outlook

vba