使用VBA收集邮件信息

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

comments powered by Disqus