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

Help with Code - Creating Status Report from Task items
 

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.

--
Viele Gruesse / Best regards
Michael Bauer - MVP Outlook
-- www.VBOffice.net --


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