Help with Code - Creating Status Report from Task items

[Steve]

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 & "<h2>Due 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 &
"<blockquote><b>Notes: </b>" & CurrentTask.Body & "</blockquote>" &
vbCrLf & vbCrLf
Else
strOutput = strOutput & vbCrLf
End If
End If
Next

strOutput = strOutput & "<h2>Due 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 & "<blockquote><b>Notes:
</b>" & CurrentTask.Body & "</blockquote>" & vbCrLf & vbCrLf
Else
strOutput = strOutput & vbCrLf
End If
End If
Next

strOutput = strOutput & "<h2>Task 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 & "<blockquote><b>Notes:
</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 = "(e-mail address removed)" ' <<< Manager's
Email address here
objMsg.CC = "(e-mail address removed)" ' 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

 

[Michael Bauer [MVP - Outlook]]

Am 1 Aug 2006 12:00:24 -0700 schrieb Steve:

You can search for "cstart" with the InStr function. E.g.

Dim pos&
pos=InStr(1, "*cstart*abc*cend*", "*cstart*", vbTextCompare)

That returns a result of 1. Add the length of the searched phrase and
subtract that from the result of searching for *cend*. That gives you the
start position and length of the part between *cstart* and *cend*. You can
extract that part now with the Mid function.

Both functions are also explained in the VBA help.