如何获取Outlook电子邮件的接收时间 [英] How to get Outlook Email received time
本文介绍了如何获取Outlook电子邮件的接收时间的处理方法,对大家解决问题具有一定的参考价值,需要的朋友们下面随着小编来一起学习吧!
问题描述
我需要从用户首选时间范围内收到的电子邮件中提取附件.
I need to extract attachments from Emails received in a user preferred time frame.
就像在2PM到4PM之间收到的电子邮件的摘要一样.
Say like extract for Emails received between 2PM to 4PM.
请找到以下我完美提取文件的代码-但这对文件夹中的所有电子邮件都适用.
Please find the below code I've that extract files perfectly - but it did for all the Emails in the folder.
请帮助我解决该问题.
Sub Unzip()
Dim ns As NameSpace 'variables for the main functionality
Dim Inbox As MAPIFolder
Dim SubFolder As MAPIFolder
Dim Atchmt As Attachment
Dim FileName As Variant
Dim msg As Outlook.MailItem
Dim FSO As Object 'variables for unzipping
Dim oApp As Object
Dim FileNameFolder As Variant
Dim Totalmsg As Object
Dim oFrom
Dim oEnd
Set ns = GetNamespace("MAPI")
Set Inbox = ns.GetDefaultFolder(olFolderInbox)
Set SubFolder = Inbox.Folders("TEST")
Set Totalmsg = msg.ReceivedTime
oFrom = InputBox("Please give start time", ("Shadowserver report"))
oEnd = InputBox("Please give End time", ("Shadowserver report"))
If Totalmsg <= oFrom And Totalmsg >= oEnd Then
For Each msg In SubFolder.Items
For Each Atchmt In msg.Attachments
If (Right(Atchmt.FileName, 3) = "zip") Then
MsgBox "1"
FileNameFolder = "C:\Users\xxxx\Documents\test\"
FileName = FileNameFolder & Atchmt.FileName
Atchmt.SaveAsFile FileName
Set oApp = CreateObject("Shell.Application")
oApp.NameSpace(FileNameFolder).CopyHere oApp.NameSpace(FileName).Items
Kill (FileName)
On Error Resume Next
Set FSO = CreateObject("scripting.filesystemobject")
FSO.deletefolder Environ("Temp") & "\Temporary Directory*", True
End If
Next
Next
End If
End Sub
推荐答案
进行了一些改进,以提高性能和清晰度:
Made a few improvements to improve performance and clarity :
- 在消息循环内测试收到的时间
- 将相关变量定义为日期(如
MsG.ReceivedTime
)并改进输入消息 - 添加了
Option Explicit
,以避免在以后的编码中出现错误(非常好的做法) - 使用
Environ$("USERPROFILE")
获取用户目录的路径 - 在循环外重新组织变量和初始化
- 添加了
LCase
以确保获取所有zip文件(包括.ZIP
)
- Test received time inside the loop on the messages
- Defined related variables as Date (like
MsG.ReceivedTime
) and improved input messages - Added
Option Explicit
to avoid mishaps in future coding (VERY GOOD PRACTICE) - Use
Environ$("USERPROFILE")
to get User directory's path - Reorganize variables and initialisation outside of the loops
- Added
LCase
to be sure to get all zips (including.ZIP
)
代码:
Option Explicit
Sub Unzip()
'''Variables for the main functionality
Dim NS As NameSpace
Dim InboX As MAPIFolder
Dim SubFolder As MAPIFolder
Dim MsG As Outlook.MailItem
Dim AtcHmt As Attachment
Dim ReceivedHour As Date
Dim oFrom As Date
Dim oEnd As Date
'''Variables for unzipping
Dim FSO As Object
Dim ShellApp As Object
Set FSO = CreateObject("Scripting.FileSystemObject")
Set ShellApp = CreateObject("Shell.Application")
Dim FileNameFolder As Variant
Dim FileName As Variant
'''Define the Outlook folder you want to scan
Set NS = GetNamespace("MAPI")
Set InboX = NS.GetDefaultFolder(olFolderInbox)
Set SubFolder = InboX.Folders("TEST")
'''Define the folder where you want to save attachments
FileNameFolder = Environ$("USERPROFILE") & "\Documents\test\"
'''Define the hours in between which you want to apply the extraction
oFrom = CDate(InputBox("Please give Start time" & vbCrLf & _
"Example: 9AM", ("Shadowserver report"), "9AM"))
oEnd = CDate(InputBox("Please give End time" & vbCrLf & _
"Example: 6PM", ("Shadowserver report"), "6PM"))
For Each MsG In SubFolder.items
ReceivedHour = MsG.ReceivedTime
If oFrom <= TimeValue(ReceivedHour) And _
TimeValue(ReceivedHour) <= oEnd Then
For Each AtcHmt In MsG.Attachments
FileName = AtcHmt.FileName
If LCase(Right(FileName, 3)) <> "zip" Then
Else
FileName = FileNameFolder & FileName
AtcHmt.SaveAsFile FileName
ShellApp.NameSpace(FileNameFolder).CopyHere _
ShellApp.NameSpace(FileName).items
Kill (FileName)
On Error Resume Next
FSO.deletefolder Environ$("Temp") & "\Temporary Directory*", True
End If
Next AtcHmt
End If
Next MsG
End Sub
这篇关于如何获取Outlook电子邮件的接收时间的文章就介绍到这了,希望我们推荐的答案对大家有所帮助,也希望大家多多支持IT屋!
查看全文