Sub CopyUnfinishedTasks()
Dim TaskFolder As Outlook.MAPIFolder
Dim TaskItems As Outlook.Items
Dim ResItems As Outlook.Items
Dim sFilter, strSubject, strNotComplete As String
Dim iNumRestricted As Integer
Dim Item, ListTasks As Object
Dim dDueDate As Date
' Use the selected calendar folder
Set TaskFolder = Application.ActiveExplorer.CurrentFolder
Set TaskItems = TaskFolder.Items
' Sort all of the appointments based on the start time
TaskItems.Sort "[Start]"
'create the Restrict filter by day and recurrence
sFilter = "[Complete] = False"
Set ResItems = TaskItems.Restrict(sFilter)
iNumRestricted = 0
'Loop through the items in the collection.
For Each Item In ResItems
iNumRestricted = iNumRestricted + 1
strSubject = Item.Subject
dDueDate = Item.DueDate
' Create list of dates
strNotComplete = strNotComplete & vbCrLf & Item.Subject & vbTab & " >> " & vbTab & Format(Item.DueDate, "mm/dd/yyyy")
Next
' Open a new email message form and insert the list of dates
Set ListTasks = Application.CreateItem(olMailItem)
ListTasks.Body = strNotComplete & vbCrLf & iNumRestricted & " tasks found."
ListTasks.Display
Set Item = Nothing
Set ListTasks = Nothing
Set ResItems = Nothing
Set TaskItems = Nothing
Set TaskFolder = Nothing
End Sub