Hi Jim,

Hereafter some code I'm using to create and send outlook tasks to my
colleagues. It's Excel 2003 VBA but think it should work also in 2007.

The code is probably not answering your question in a direct way, but you
should be able to find in it how to create a task in outlook using excel.

Wkr,

JP Ronse



'''''''''''''''''''''''''''''''''''''''''''''''''' '''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''' '''''''''''''''''''''''''''
''' Procedu AssignTask(rngActiveCell as range)
'''
''' Comments:
'''
'''
''' © 2004 Jean-Pierre Degroote
'''
''' Date Developer Action
''' -------------------------------------------------------------------------
''' 26/12/2004 Jean-Pierre Degroote Created
'''
Sub AssignTask(rngActiveCell As Range)
Dim strMailAddress As String
Dim strFirstName As String
Dim strCommentText As String
Dim varSendDisplay As Variant
Dim dblStartTime As Double
Dim dblEndTime As Double

On Error Resume Next
''' check if a mail address is valid
strMailAddress = Application.VLookup(Cells(2, rngActiveCell.Column),
Sheets("Engineers").Cells(1, 1).CurrentRegion, 3, False)
'''strMailAddress = TranslateName(Cells(2, rngActiveCell.Column),
strFirstName)
strFirstName = Application.VLookup(Cells(2, rngActiveCell.Column),
Sheets("Engineers").Cells(1, 1).CurrentRegion, 2, False)

gintPos = InStr(1, strMailAddress, "@", vbTextCompare)
If gintPos = 1 Then GoTo Exit_Notify

strCommentText = rngActiveCell.Comment.Text
''' if chr(10) limit to first
gintPos = InStr(1, strCommentText, Chr(10), vbTextCompare)
If gintPos 0 Then
strCommentText = Left(strCommentText, gintPos - 1)
End If

''' remove T! mark
If InStr(1, strCommentText, "!") = 2 Then
strCommentText = Mid(strCommentText, 4)
End If
Set gobjOutlook = GetObject(, "Outlook.application")

Set gobjTask = gobjOutlook.CreateItem(olTaskItem)
With gobjTask
gintPos = InStr(1, strCommentText, " ", vbTextCompare)
If gintPos = 0 Then
.Subject = rngActiveCell & " " & strCommentText & ": Task
Assignment"
Else
.Subject = rngActiveCell & " " & Left(strCommentText, gintPos -
1) & ": Task Assignment"
End If
.Body = "Dear " & strFirstName & vbCr & vbCr
If gintPos = 0 Then
.Body = .Body & "Please accept this task: " & rngActiveCell & "
" & strCommentText
Else
.Body = .Body & "Please accept this task: " & rngActiveCell & "
" & Left(strCommentText, gintPos - 1)
End If
.Body = .Body & vbCr & vbCr
.Body = .Body & "Best regards," & vbCr
.Body = .Body & PlanningUser & vbCr & vbCr
''' add comment to body
.Body = .Body & rngActiveCell.Comment.Text

.startdate = Cells(rngActiveCell.Row, 1)
.DueDate = .startdate + Mid(strCommentText, InStr(1, strCommentText,
"/", vbTextCompare) + 1)
''' correct due date, check if owner is working
gintPos = .DueDate - .startdate
Do While gintPos = 1
Select Case rngActiveCell.Offset(gintPos, 0)
Case "M", "A", "N", "D", "D1", "D2", "D3", "AS35"
Exit Do
Case Else
''' correct duedate
.DueDate = .DueDate - 1
gintPos = gintPos - 1
End Select
Loop

''' add task from startdate to duedate
For gintPos = 1 To .DueDate - .startdate
Select Case rngActiveCell.Offset(gintPos, 0)
Case "M", "A", "N", "D", "D1", "D2", "D3"
If HasComment(rngActiveCell.Offset(gintPos, 0)) Then
rngActiveCell.Offset(gintPos, 0).Comment.Text
Text:=strCommentText & Chr(10) & rngActiveCell.Offset(gintPos,
0).Comment.Text
Else
AddComment rngActiveCell.Offset(gintPos, 0),
strCommentText
End If
rngActiveCell.Offset(gintPos, 0).Interior.ColorIndex =
CLR_ATTENTION
End Select

Next gintPos

Set gobjMailAddress = .Recipients.Add(strMailAddress)
'''Set gobjMailAddress = ")
'''gobjMailAddress.Type = olBCC
'''gobjMailAddress.Type = olCC
.Assign
'''.StatusReport
.StatusOnCompletionRecipients = "
'''.StatusUpdateRecipients = "
.ReminderSet = True
.ReminderTime = .DueDate - 1
.Display
End With
Set gobjTask = Nothing
Set gobjOutlook = Nothing
With rngActiveCell.Interior
.ColorIndex = CLR_TASKS
.Pattern = xlCrissCross
.PatternColorIndex = 15
End With
Exit_Notify:
On Error GoTo 0
End Sub



"Jim" wrote in message
...
I'm using Excel Office 2007. I would like a VBA code to create a task in
Outlook based on a date in an Excel workbook. Once the task is completed,
I
would like that completion date entered into the Excel Workbook. Is this
possible?

My initial date is located in the workbook 'Loan Book', worksheet 'Loan
Data' cell CN9. I would like the task completion due date to be four days
prior to the sheet date. Once the task is completed, I would like that
completion date CP9.

Thanks in advance for any advice.