Help with Code - Creating Status Report from Task items
Hi all,
I located the following code from another post within this group. It
does most of what I want but I was wonderering if there is a way to
parse each task and copy on the lines that stat with
*cstart* and ends with *cend*
When I update my task with comments I start the comment with *cstart*
and end it with *cend*
This is needed because several of my task originate from long email
threads and since this is just a high level report I want to capture
the whole body.
Anyone done this before if so care to share your approach?
Thanks
Steve
***Start Code
Sub CreateStatusReport()
Dim objOutlook
Dim objNameSpace
Dim objFolder
Dim MyItems
Dim CurrentTask
Dim strOutput
Const olMailItem = 0
Const olTaskItem = 3
Const olFolderTasks = 13
'Create Outlook, Namespace, Folder Objects and Task Item
Set objOutlook = CreateObject("Outlook.application")
Set objNameSpace = objOutlook.GetNamespace("MAPI")
Set objFolder =
objNameSpace.GetDefaultFolder(olFolderTasks)
Set MyItems = objFolder.Items
dtLastWeek = DateAdd("d", -7, Date)
dtNextWeek = DateAdd("d", 7, Date)
'Loop through all tasks with a Due Date on or before Today.
strOutput = strOutput & "h2Due This Week/h2"
icount = 0
For Each CurrentTask In MyItems
If CurrentTask.DueDate = dtLastWeek And
CurrentTask.DueDate = Date Then
icount = icount + 1
strOutput = " " & strOutput & "b" & icount & ".
" & CurrentTask.Subject & " ------- " & CurrentTask.PercentComplete &
"% Completed/b"
If CurrentTask.Complete Then
strOutput = strOutput & "-b
ACCOMPLISHMENTS/b-" & vbCrLf
Else
strOutput = strOutput & vbCrLf
End If
If Len(CurrentTask.Body) 0 Then
strOutput = " " & strOutput &
"blockquotebNotes: /b" & CurrentTask.Body & "/blockquote" &
vbCrLf & vbCrLf
Else
strOutput = strOutput & vbCrLf
End If
End If
Next
strOutput = strOutput & "h2Due Next Week/h2"
icount = 0
For Each CurrentTask In MyItems
If CurrentTask.DueDate Date And CurrentTask.DueDate
= dtNextWeek Then
icount = icount + 1
strOutput = strOutput & icount & ". " &
CurrentTask.Subject
If CurrentTask.Complete Then
strOutput = strOutput & "-b
ACCOMPLISHMENTS/b-" & vbCrLf
Else
strOutput = strOutput & vbCrLf
End If
If Len(CurrentTask.Body) 0 Then
strOutput = strOutput & "blockquotebNotes:
/b" & CurrentTask.Body & "/blockquote" & vbCrLf & vbCrLf
Else
strOutput = strOutput & vbCrLf
End If
End If
Next
strOutput = strOutput & "h2Task in Progress/h2"
icount = 0
For Each CurrentTask In MyItems
If CurrentTask.DueDate = dtNextWeek Then
icount = icount + 1
strOutput = strOutput & icount & ". " &
CurrentTask.Subject
strOutput = strOutput & " Due -b " &
CurrentTask.DueDate & "/b" & vbCrLf
If Len(CurrentTask.Body) 0 Then
strOutput = strOutput & "blockquotebNotes:
/b" & CurrentTask.Body & "/blockquote" & vbCrLf & vbCrLf
Else
strOutput = strOutput & vbCrLf
End If
End If
Next
' create new outgoing message
Set objMsg = objOutlook.CreateItem(olMailItem)
objMsg.To = " ' Manager's
Email address here
objMsg.CC = " ' Send Copy of to
myself
objMsg.Subject = "Steve J. Jones Status Report - " & Date
' Change Email subject here
objMsg.Display
strOutput = Replace(strOutput, vbCrLf, "br")
objMsg.HTMLBody = strOutput
'Clean up
Set objFolder = Nothing
Set objNameSpace = Nothing
Set objOutlook = Nothing
Set objMsg = Nothing
End Sub
***End CODE
|