View Single Post
  #5   Report Post  
Posted to microsoft.public.excel.programming
papou[_2_] papou[_2_] is offline
external usenet poster
 
Posts: 112
Default Searching for an Outlook Task from Excel

Other alternative: use a Like comparison,
but this will change the finding method and be aware that it may result in
finding several matching tasks.
HTH
Cordially
Pascal

Sub CreateTask()
'Reference must be set to Microsoft Outlook x.0 Object Library
Dim olApp As Outlook.Application

Dim olFoundTask As Boolean
Dim olTaskIt As TaskItem
Dim olTasks As Outlook.MAPIFolder
Dim olNameSpace As Outlook.Namespace
Set olApp = New Outlook.Application

Set olNameSpace = olApp.GetNamespace("MAPI")
Set olTasks = olNameSpace.GetDefaultFolder(olFolderTasks)

For Each olTaskIt In olTasks.Items
If olTaskIt.Subject Like "Jeff*" Then
olFoundTask = True

With olTaskIt
.Subject = Range("A6")
.Status = olTaskInProgress
.Importance = olImportanceHigh
.DueDate = Range("B6")
.TotalWork = 40
.ActualWork = 20
.CardData = "New" & Range("b6")
.Save
End With
MsgBox "Task item found and amended"
Exit For
Else
olFoundTask = False
End If

Next olTaskIt

If Not olFoundTask Then MsgBox "No task items matching criteria in
subject caption were found"

Set olTaskIt = Nothing
Set olTasks = Nothing
Set olNameSpace = Nothing
Set olApp = Nothing

End Sub

"papou" a écrit dans le message de news:
...
You can't expect the code to match your task item because its subject is
not Jeff but "Jeff Smith - 92 Wynora Street".
So in my opinion you will need to fill in the exact matching subject
caption in your code eg:
Set olFoundTask = olTasks.Items.Find("[Subject] = 'Jeff' Smith - 92
Wynora Street'")

HTH
Cordially
Pascal

"scott56hannah" a écrit dans le
message de news:
...
Have tried the suggested amendment and it still does not seem to register
the
olFoundTask as an item object.....that is it does not match and continues
on
to say not found.

The subject value in a task within my Outlook has the following "Jeff
Smith
- 92 Wynora Street".....so I cannot understand why it is not working....

Any help would be appreciated.....


"papou" wrote:

Hello

Here's some suggested amendment to your code below, tested with success
on
Office 2003 SP3.

HTH

Cordially
Pascal

Sub ModifyTask()
'Reference must be set to Microsoft Outlook x.0 Object Library
Dim olApp As Outlook.Application

Dim olFoundTask As TaskItem
Dim olTasks As Outlook.MAPIFolder
Dim olNameSpace As Outlook.Namespace

Set olApp = New Outlook.Application

Set olNameSpace = olApp.GetNamespace("MAPI")
Set olTasks = olNameSpace.GetDefaultFolder(olFolderTasks)
Set olFoundTask = olTasks.Items.Find("[Subject] = 'Jeff'")
If Not olFoundTask Is Nothing Then
With olFoundTask
.Subject = Range("A6")
.Status = olTaskInProgress
.Importance = olImportanceHigh
.DueDate = Range("B6")
.TotalWork = 40
.ActualWork = 20
'.CardData = "New" & Range("b6")
.Save
End With
Else
MsgBox "Task was not found", vbInformation
End If

Set olFoundTask = Nothing
Set olTasks = Nothing
Set olNameSpace = Nothing
Set olApp = Nothing

End Sub


"scott56hannah" a écrit dans
le
message de news:
...
I got some help regarding creating an outlook task from Excel....that
worked...

I would now like to be able to search for an existing outlook task on
a
users PC and then if it exists update it...

I have the following code so far....Find statement does not seem to be
returning values but the search values are valid for entries in the
Outlook
tasks....

Any help appreciated....

Sub CreateTask()

Dim olApp As Outlook.Application
Dim olTsk As TaskItem

Dim olFoundTask As TaskItem
Dim olTasks As Outlook.MAPIFolder
Dim olNameSpace As Outlook.Namespace


Set olApp = CreateObject("Outlook.Application")
Set olNameSpace = olApp.GetNamespace("MAPI")
Set olTasks = olNameSpace.GetDefaultFolder(olFolderTasks)
Set olFoundTask = olTasks.Items.Find("[Subject] = 'Jeff'")


Set olApp = New Outlook.Application
Set olTsk = olApp.CreateItem(olTaskItem)

With olTsk
.Subject = Range("A6")
.Status = olTaskInProgress
.Importance = olImportanceHigh
.DueDate = Range("B6")
.TotalWork = 40
.ActualWork = 20
.CardData = "New" & Range("b6")
.Save
End With

Set olTsk = Nothing
Set olApp = Nothing

End Sub