14 Jun 2013
需求:通过macro生成上个月回复的邮件信息(包括标题,发件人,收到时间,回复时间等)
Sub test()
'Get all mail in Inbox
Dim PtFolder As Folder
Dim PtAllItems As Items
Set PtFolder = Session.GetDefaultFolder(olFolderInbox)
Set PtAllItems = PtFolder.Items
Dim CurUser As String
CurUser = PtFolder.Session.CurrentUser
'Filter the mail according date
Dim dtDateTimetoStart0 As String, dtDateTimetoEnd0 As String
dtDateTimetoStart0 = "01/05/2013"
dtDateTimetoEnd0 = "01/06/2013"
dtDateTimetoStart = CDate(dtDateTimetoStart0)
dtDateTimetoEnd = CDate(dtDateTimetoEnd0)
sFilter = "[ReceivedTime]>= """ & dtDateTimetoStart & """ And [ReceivedTime]< """ & dtDateTimetoEnd & """"
Dim PtItems As Items
Set PtItems = PtAllItems.Restrict(sFilter)
'Print out Mail information
PR_LAST_VERB_EXECUTED = "http://schemas.microsoft.com/mapi/proptag/0x10810003"
PR_LAST_VERB_EXECUTION_TIME = "http://schemas.microsoft.com/mapi/proptag/0x10820040"
Dim oPA As PropertyAccessor
Dim Mail As Object
For Each Mail In PtItems
'Check if is MailItem
If TypeOf Mail Is MailItem Then
'Get last action and last action time by PropertyAccessor. This can check if the mail have been replied.
Set oPA = Mail.PropertyAccessor
If oPA.GetProperty(PR_LAST_VERB_EXECUTED) <> 0 Then
RecDate = Mail.ReceivedTime
RepDate1 = oPA.GetProperty(PR_LAST_VERB_EXECUTION_TIME)
RepDate = DateAdd("h", 8, RepDate1)
DiffTime = DateDiff("n", RecDate, RepDate)
DiffTimeHr = Format(DiffTime / 60, "###0.0")
If Mail.Importance = 2 Then
IsImportance = "Y"
Else
IsImportance = "N"
End If
Dim text As String
text = (Mail.Subject) & Chr(9) & Mail.SenderName & Chr(9) & CurUser & Chr(9) & Format(RecDate, "Medium Date") & Chr(9) & Format(RecDate, "Medium Time") & Chr(9) & Format(RepDate, "Medium Date") & Chr(9) & Format(RepDate, "Medium Time") & Chr(9) & DiffTime & Chr(9) & DiffTimeHr & Chr(9) & Chr(9) & Chr(9) & IsImportance
sFile = "C:\Users\123\desktop\\pending.txt"
iFileNum = FreeFile
Open sFile For Append As iFileNum
Print #iFileNum, text
Close #iFileNum
End If
End If
Next
Debug.Print "Hello" & vbTab & "1" & Chr(9) & "2"
End Sub