' THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

Function GetEmailsMarkedForFollowUp(myOlFolder As Outlook.Folder)
    Dim objTable As Outlook.Table
    Dim objRow As Outlook.Row
    Dim strFilter As String
    Dim strReturn As String
    Dim myObjSubFolder As Outlook.Folder
    Dim intCurrent As Integer
        
    ' ignore certain folders in the interest of having outlook return sometime in the foreseeable future
    If (myOlFolder.Name = "Trash") Or (myOlFolder.Name = "Archive") Or (myOlFolder.Name = "Junk") Or (myOlFolder.Name = "Junk E-mail") Then
        GetEmailsMarkedForFollowUp = ""
        Exit Function
    End If
        
    ' clear string
    strReturn = ""
       
    ' Define a DASL filter that finds items marked for follow-up
    strFilter = "@SQL=" & Chr(34) & "http://schemas.microsoft.com/mapi/proptag/0x0E2B0003" & Chr(34) & " = 1"
        
    ' construct a table of items using the filter
    Set objTable = myOlFolder.GetTable(strFilter)
    
    With objTable
    
        ' Add task-related columns to the table.
        .Columns.Add ("TaskDueDate")    ' this always seems to be blank in imap, but might be useful if you use exchange
        .Columns.Add ("Subject")
        .Columns.Add ("Categories")
        .Columns.Add ("SenderName")
        
        ' add flagged e-mails to the formatted task string
        Do Until .EndOfTable
            Set objRow = .GetNextRow
            
            strReturn = strReturn & "<div style=""margin: 0; padding: 0; width: 100%; font-size: .85em; font-family: Verdana; background-color: #EDEDED;"">"
            strReturn = strReturn & objRow("Subject") & "</div><div style=""margin: 0; padding: 0;"">"
            strReturn = strReturn & "<span style=""font-size: .75em;""><b>From:</b> " & objRow("SenderName") & "</span><br/>"
            strReturn = strReturn & "<span style=""font-size: .75em;""><b>Category:</b> " & objRow("Categories") & "</span><br/>"
            strReturn = strReturn & "<br/></div>"
        Loop
    End With

    ' clean up
    Set objRow = Nothing
    Set objTable = Nothing
    
    ' check subfolders
    intCurrent = 1
    While intCurrent < myOlFolder.Folders.count
        strReturn = strReturn & GetEmailsMarkedForFollowUp(myOlFolder.Folders.Item(intCurrent))
        intCurrent = intCurrent + 1
    Wend
    
    ' return the result
    GetEmailsMarkedForFollowUp = strReturn
End Function

Sub CreateToDoMail(strAccountName As String)
    Dim myOlApp As New Outlook.Application
    Dim myOlNameSpace As Outlook.NameSpace
    Dim objTaskFolder As Outlook.Folder
    Dim myObjTask As Outlook.TaskItem
    Dim myObjMail As Outlook.MailItem
    Dim strEmailBody As String
        
    ' get the task list
    Set myOlNameSpace = myOlApp.GetNamespace("MAPI")
    Set objTaskFolder = myOlNameSpace.GetDefaultFolder(olFolderTasks)
        
    ' add each task item to an html-formatted list
    strEmailBody = "<h3 style=""font-family: Verdana; padding: 0: margin: 0"">Tasks</h3>"
    For Each myObjTask In objTaskFolder.Items
        If Not myObjTask.Complete Then
            strEmailBody = strEmailBody & "<div style=""margin: 0; padding: 0; width: 100%; font-size: .85em; font-family: Verdana; background-color: #EDEDED;"">"
            If myObjTask.Importance = 2 Then
                strEmailBody = strEmailBody & "<span style=""font-weight: bold; color: red;"">!</span> "
            End If
            strEmailBody = strEmailBody & myObjTask.Subject & "</div><div style=""margin: 0; padding: 0;"">"
            strEmailBody = strEmailBody & "<span style=""font-size: .75em;""><b>Date due:</b> " & myObjTask.DueDate & "</span><br/>"
            strEmailBody = strEmailBody & "<span style=""font-size: .75em;""><b>Category:</b> " & myObjTask.Categories & "</span><br/>"
            strEmailBody = strEmailBody & "<br/></div>"
        End If
    Next
    
    ' also add mail items that have been marked for follow-up
    strEmailBody = strEmailBody & "<h3 style=""font-family: Verdana; padding: 0: margin: 0""><br/>Mail Items Marked for Follow-Up</h3>"
    strEmailBody = strEmailBody & GetEmailsMarkedForFollowUp(myOlNameSpace.Folders(strAccountName))

    ' create a new html e-mail message
    Set myObjMail = myOlApp.CreateItem(olMailItem)
    myObjMail.Subject = "My To-Do List: " & Date
    myObjMail.BodyFormat = olFormatHTML
    myObjMail.HTMLBody = strEmailBody
    myObjMail.Display
End Sub

Sub CreateToDoMailLisa()
    CreateToDoMail "lisa@tfpsoft.com"
End Sub