Need Help from an Outlook Expert; Probably MVP-Level

R

ryguy7272

The code below fails on this line:
While ((j < totalcount) And (myItems(j).Class <> olTask))

I put the cursor over j and see that Excel interprets it as 1, and I put the
cursor over totalcount and I see that Excel interprets it as 0; both of these
values seem correct to me.


Public Sub DeleteDuplicateTasks()

Dim oldTask As TaskItem, newTask As TaskItem, j As Integer
Dim iCounter As Integer

Set myNameSpace = GetNamespace("MAPI")
Set myFolder = myNameSpace.GetDefaultFolder(olFolderTasks)
Set myItems = myFolder.Items
'myItems.Sort "[File As]", olDescending
totalcount = myItems.Count
j = 1
While ((j < totalcount) And (myItems(j).Class <> olTask))
j = j + 1
Wend
Set oldTask = myItems(j)
For i = j + 1 To totalcount
If (myItems(i).Class = olTask) Then
'(newTask.Body = oldTask.Body) And _

Set newTask = myItems(i)
If ((newTask.Subject = oldTask.Subject)) Then
' (newTask.DueDate = oldTask.DueDate) And _

newTask.Mileage = "DELETEME"
iCounter = iCounter + 1
newTask.Save
End If
Set oldTask = newTask
End If
Next i
If iCounter = 0 Then
MsgBox "No duplicate Tasks were detected in " & totalcount & " Tasks!",
vbInformation, "No duplicates"
Else
MsgBox iCounter & " duplicate Tasks were detected and flagged!",
vbInformation, "Duplicates detected"
End If
End Sub

I found this code here:
http://www.outlookcode.com/threads.aspx?forumid=2&messageid=21714
I commented out this line:
'myItems.Sort "[File As]", olDescending

I had it running a couple of days ago, but now it doesn’t run at all.
Although the results were somewhat incorrect, at least the code ran. I tried
to make a few small modifications, and now it doesn’t do anything at all.


Ken gave me the code below (thanks buddy).
The code below fails on this line:
Set colRestrict = myItems.Restrict("[Subject] = " & Chr(34) &
newTask.Subject & Chr(34))

…I made a small modification to Ken’s code and I’m ignoring any possibility
of word wrap as the culprit.

Sub DeleteDupes()
Set myNameSpace = GetNamespace("MAPI")
Set myFolder = myNameSpace.GetDefaultFolder(olFolderTasks)
Set myItems = myFolder.Items
Dim colRestrict As Outlook.Items
Set colRestrict = myItems.Restrict("[Subject] = " & Chr(34) &
newTask.Subject & Chr(34))
If colRestrict.Count = 0 Then ' no items with that Subject
'blah, blah, whatever
Else ' there is at least one dupe
' find the dupe and delete it
If colRestrict.Count = 1 Then
colRestrict.Items(1).Delete
Else
For i = colRestrict.Count To 1 Step -1
colRestrict.Items(i).Remove
Next
End If
End If
End Sub


Basically, I am trying to eliminate any and all duplicate Tasks in the Task
folder. I have some great experience doing VBA programming in an Excel
environment but virtually no experience doing VBA programming in an Outlook
environment, so I am at a huge disadvantage here. Can any Outlook expert
review these two Subs and find anything wrong here? I can’t figure out what
the problem is. :(

Regards,
Ryan--
 
A

Aravind

1 < 0 is always going to fail (i.e. return FALSE).


Aravind


ryguy7272 said:
The code below fails on this line:
While ((j < totalcount) And (myItems(j).Class <> olTask))

I put the cursor over j and see that Excel interprets it as 1, and I put the
cursor over totalcount and I see that Excel interprets it as 0; both of these
values seem correct to me.


Public Sub DeleteDuplicateTasks()

Dim oldTask As TaskItem, newTask As TaskItem, j As Integer
Dim iCounter As Integer

Set myNameSpace = GetNamespace("MAPI")
Set myFolder = myNameSpace.GetDefaultFolder(olFolderTasks)
Set myItems = myFolder.Items
'myItems.Sort "[File As]", olDescending
totalcount = myItems.Count
j = 1
While ((j < totalcount) And (myItems(j).Class <> olTask))
j = j + 1
Wend
Set oldTask = myItems(j)
For i = j + 1 To totalcount
If (myItems(i).Class = olTask) Then
'(newTask.Body = oldTask.Body) And _

Set newTask = myItems(i)
If ((newTask.Subject = oldTask.Subject)) Then
' (newTask.DueDate = oldTask.DueDate) And _

newTask.Mileage = "DELETEME"
iCounter = iCounter + 1
newTask.Save
End If
Set oldTask = newTask
End If
Next i
If iCounter = 0 Then
MsgBox "No duplicate Tasks were detected in " & totalcount & " Tasks!",
vbInformation, "No duplicates"
Else
MsgBox iCounter & " duplicate Tasks were detected and flagged!",
vbInformation, "Duplicates detected"
End If
End Sub

I found this code here:
http://www.outlookcode.com/threads.aspx?forumid=2&messageid=21714
I commented out this line:
'myItems.Sort "[File As]", olDescending

I had it running a couple of days ago, but now it doesn’t run at all.
Although the results were somewhat incorrect, at least the code ran. I tried
to make a few small modifications, and now it doesn’t do anything at all.


Ken gave me the code below (thanks buddy).
The code below fails on this line:
Set colRestrict = myItems.Restrict("[Subject] = " & Chr(34) &
newTask.Subject & Chr(34))

…I made a small modification to Ken’s code and I’m ignoring any possibility
of word wrap as the culprit.

Sub DeleteDupes()
Set myNameSpace = GetNamespace("MAPI")
Set myFolder = myNameSpace.GetDefaultFolder(olFolderTasks)
Set myItems = myFolder.Items
Dim colRestrict As Outlook.Items
Set colRestrict = myItems.Restrict("[Subject] = " & Chr(34) &
newTask.Subject & Chr(34))
If colRestrict.Count = 0 Then ' no items with that Subject
'blah, blah, whatever
Else ' there is at least one dupe
' find the dupe and delete it
If colRestrict.Count = 1 Then
colRestrict.Items(1).Delete
Else
For i = colRestrict.Count To 1 Step -1
colRestrict.Items(i).Remove
Next
End If
End If
End Sub


Basically, I am trying to eliminate any and all duplicate Tasks in the Task
folder. I have some great experience doing VBA programming in an Excel
environment but virtually no experience doing VBA programming in an Outlook
environment, so I am at a huge disadvantage here. Can any Outlook expert
review these two Subs and find anything wrong here? I can’t figure out what
the problem is. :(

Regards,
Ryan--
Click to expand...
 
R

ryguy7272

Good catch Aravind. Actually, I had no tasks in the Task Folder at the time.
Now with a few tasks in there, and two dupes, it seems to be counting the
items correctly, the only thing it does not do is delete the duplicate tasks
when the dupes are found and counted. I've narrowed the problem to this
snippet of code:

newTask.Mileage = "DELETEME"
iCounter = iCounter + 1
newTask.Save
End If
Set oldTask = newTask

I think the one line that is giving me problems is this:
Set oldTask = newTask

I tried things like this:
newTask.Subject = Remove

This removes the Subject from the Task (appropriate, right). What is the
code to remove the entire Task from the Task folder? I'm sooooo close to
resolving this; at this point I just need a little push.

Regards,
Ryan--

--
RyGuy


Aravind said:
1 < 0 is always going to fail (i.e. return FALSE).


Aravind


ryguy7272 said:
The code below fails on this line:
While ((j < totalcount) And (myItems(j).Class <> olTask))

I put the cursor over j and see that Excel interprets it as 1, and I put the
cursor over totalcount and I see that Excel interprets it as 0; both of these
values seem correct to me.


Public Sub DeleteDuplicateTasks()

Dim oldTask As TaskItem, newTask As TaskItem, j As Integer
Dim iCounter As Integer

Set myNameSpace = GetNamespace("MAPI")
Set myFolder = myNameSpace.GetDefaultFolder(olFolderTasks)
Set myItems = myFolder.Items
'myItems.Sort "[File As]", olDescending
totalcount = myItems.Count
j = 1
While ((j < totalcount) And (myItems(j).Class <> olTask))
j = j + 1
Wend
Set oldTask = myItems(j)
For i = j + 1 To totalcount
If (myItems(i).Class = olTask) Then
'(newTask.Body = oldTask.Body) And _

Set newTask = myItems(i)
If ((newTask.Subject = oldTask.Subject)) Then
' (newTask.DueDate = oldTask.DueDate) And _

newTask.Mileage = "DELETEME"
iCounter = iCounter + 1
newTask.Save
End If
Set oldTask = newTask
End If
Next i
If iCounter = 0 Then
MsgBox "No duplicate Tasks were detected in " & totalcount & " Tasks!",
vbInformation, "No duplicates"
Else
MsgBox iCounter & " duplicate Tasks were detected and flagged!",
vbInformation, "Duplicates detected"
End If
End Sub

I found this code here:
http://www.outlookcode.com/threads.aspx?forumid=2&messageid=21714
I commented out this line:
'myItems.Sort "[File As]", olDescending

I had it running a couple of days ago, but now it doesn’t run at all.
Although the results were somewhat incorrect, at least the code ran. I tried
to make a few small modifications, and now it doesn’t do anything at all.


Ken gave me the code below (thanks buddy).
The code below fails on this line:
Set colRestrict = myItems.Restrict("[Subject] = " & Chr(34) &
newTask.Subject & Chr(34))

…I made a small modification to Ken’s code and I’m ignoring any possibility
of word wrap as the culprit.

Sub DeleteDupes()
Set myNameSpace = GetNamespace("MAPI")
Set myFolder = myNameSpace.GetDefaultFolder(olFolderTasks)
Set myItems = myFolder.Items
Dim colRestrict As Outlook.Items
Set colRestrict = myItems.Restrict("[Subject] = " & Chr(34) &
newTask.Subject & Chr(34))
If colRestrict.Count = 0 Then ' no items with that Subject
'blah, blah, whatever
Else ' there is at least one dupe
' find the dupe and delete it
If colRestrict.Count = 1 Then
colRestrict.Items(1).Delete
Else
For i = colRestrict.Count To 1 Step -1
colRestrict.Items(i).Remove
Next
End If
End If
End Sub


Basically, I am trying to eliminate any and all duplicate Tasks in the Task
folder. I have some great experience doing VBA programming in an Excel
environment but virtually no experience doing VBA programming in an Outlook
environment, so I am at a huge disadvantage here. Can any Outlook expert
review these two Subs and find anything wrong here? I can’t figure out what
the problem is. :(

Regards,
Ryan--
Click to expand...
Click to expand...
 
A

Aravind

I haven't worked with Tasks yet, but isn't there a newtask.Delete?


Aravind

ryguy7272 said:
Good catch Aravind. Actually, I had no tasks in the Task Folder at the time.
Now with a few tasks in there, and two dupes, it seems to be counting the
items correctly, the only thing it does not do is delete the duplicate tasks
when the dupes are found and counted. I've narrowed the problem to this
snippet of code:

newTask.Mileage = "DELETEME"
iCounter = iCounter + 1
newTask.Save
End If
Set oldTask = newTask

I think the one line that is giving me problems is this:
Set oldTask = newTask

I tried things like this:
newTask.Subject = Remove

This removes the Subject from the Task (appropriate, right). What is the
code to remove the entire Task from the Task folder? I'm sooooo close to
resolving this; at this point I just need a little push.

Regards,
Ryan--

--
RyGuy


Aravind said:
1 < 0 is always going to fail (i.e. return FALSE).


Aravind


ryguy7272 said:
The code below fails on this line:
While ((j < totalcount) And (myItems(j).Class <> olTask))

I put the cursor over j and see that Excel interprets it as 1, and I put the
cursor over totalcount and I see that Excel interprets it as 0; both of these
values seem correct to me.


Public Sub DeleteDuplicateTasks()

Dim oldTask As TaskItem, newTask As TaskItem, j As Integer
Dim iCounter As Integer

Set myNameSpace = GetNamespace("MAPI")
Set myFolder = myNameSpace.GetDefaultFolder(olFolderTasks)
Set myItems = myFolder.Items
'myItems.Sort "[File As]", olDescending
totalcount = myItems.Count
j = 1
While ((j < totalcount) And (myItems(j).Class <> olTask))
j = j + 1
Wend
Set oldTask = myItems(j)
For i = j + 1 To totalcount
If (myItems(i).Class = olTask) Then
'(newTask.Body = oldTask.Body) And _

Set newTask = myItems(i)
If ((newTask.Subject = oldTask.Subject)) Then
' (newTask.DueDate = oldTask.DueDate) And _

newTask.Mileage = "DELETEME"
iCounter = iCounter + 1
newTask.Save
End If
Set oldTask = newTask
End If
Next i
If iCounter = 0 Then
MsgBox "No duplicate Tasks were detected in " & totalcount & " Tasks!",
vbInformation, "No duplicates"
Else
MsgBox iCounter & " duplicate Tasks were detected and flagged!",
vbInformation, "Duplicates detected"
End If
End Sub

I found this code here:
http://www.outlookcode.com/threads.aspx?forumid=2&messageid=21714
I commented out this line:
'myItems.Sort "[File As]", olDescending

I had it running a couple of days ago, but now it doesn’t run at all.
Although the results were somewhat incorrect, at least the code ran. I tried
to make a few small modifications, and now it doesn’t do anything at all.


Ken gave me the code below (thanks buddy).
The code below fails on this line:
Set colRestrict = myItems.Restrict("[Subject] = " & Chr(34) &
newTask.Subject & Chr(34))

…I made a small modification to Ken’s code and I’m ignoring any possibility
of word wrap as the culprit.

Sub DeleteDupes()
Set myNameSpace = GetNamespace("MAPI")
Set myFolder = myNameSpace.GetDefaultFolder(olFolderTasks)
Set myItems = myFolder.Items
Dim colRestrict As Outlook.Items
Set colRestrict = myItems.Restrict("[Subject] = " & Chr(34) &
newTask.Subject & Chr(34))
If colRestrict.Count = 0 Then ' no items with that Subject
'blah, blah, whatever
Else ' there is at least one dupe
' find the dupe and delete it
If colRestrict.Count = 1 Then
colRestrict.Items(1).Delete
Else
For i = colRestrict.Count To 1 Step -1
colRestrict.Items(i).Remove
Next
End If
End If
End Sub


Basically, I am trying to eliminate any and all duplicate Tasks in the Task
folder. I have some great experience doing VBA programming in an Excel
environment but virtually no experience doing VBA programming in an Outlook
environment, so I am at a huge disadvantage here. Can any Outlook expert
review these two Subs and find anything wrong here? I can’t figure out what
the problem is. :(

Regards,
Ryan--
Click to expand...
Click to expand...
Click to expand...
 
R

ryguy7272

No...well it's not that easy. I tried several combinations of things, and
this causes an error on this line:
If ((newTask.Subject = oldTask.Subject)) Then

Any other ideas?
TIA!

--
RyGuy


Aravind said:
I haven't worked with Tasks yet, but isn't there a newtask.Delete?


Aravind

ryguy7272 said:
Good catch Aravind. Actually, I had no tasks in the Task Folder at the time.
Now with a few tasks in there, and two dupes, it seems to be counting the
items correctly, the only thing it does not do is delete the duplicate tasks
when the dupes are found and counted. I've narrowed the problem to this
snippet of code:

newTask.Mileage = "DELETEME"
iCounter = iCounter + 1
newTask.Save
End If
Set oldTask = newTask

I think the one line that is giving me problems is this:
Set oldTask = newTask

I tried things like this:
newTask.Subject = Remove

This removes the Subject from the Task (appropriate, right). What is the
code to remove the entire Task from the Task folder? I'm sooooo close to
resolving this; at this point I just need a little push.

Regards,
Ryan--

--
RyGuy


Aravind said:
1 < 0 is always going to fail (i.e. return FALSE).


Aravind


:

The code below fails on this line:
While ((j < totalcount) And (myItems(j).Class <> olTask))

I put the cursor over j and see that Excel interprets it as 1, and I put the
cursor over totalcount and I see that Excel interprets it as 0; both of these
values seem correct to me.


Public Sub DeleteDuplicateTasks()

Dim oldTask As TaskItem, newTask As TaskItem, j As Integer
Dim iCounter As Integer

Set myNameSpace = GetNamespace("MAPI")
Set myFolder = myNameSpace.GetDefaultFolder(olFolderTasks)
Set myItems = myFolder.Items
'myItems.Sort "[File As]", olDescending
totalcount = myItems.Count
j = 1
While ((j < totalcount) And (myItems(j).Class <> olTask))
j = j + 1
Wend
Set oldTask = myItems(j)
For i = j + 1 To totalcount
If (myItems(i).Class = olTask) Then
'(newTask.Body = oldTask.Body) And _

Set newTask = myItems(i)
If ((newTask.Subject = oldTask.Subject)) Then
' (newTask.DueDate = oldTask.DueDate) And _

newTask.Mileage = "DELETEME"
iCounter = iCounter + 1
newTask.Save
End If
Set oldTask = newTask
End If
Next i
If iCounter = 0 Then
MsgBox "No duplicate Tasks were detected in " & totalcount & " Tasks!",
vbInformation, "No duplicates"
Else
MsgBox iCounter & " duplicate Tasks were detected and flagged!",
vbInformation, "Duplicates detected"
End If
End Sub

I found this code here:
http://www.outlookcode.com/threads.aspx?forumid=2&messageid=21714
I commented out this line:
'myItems.Sort "[File As]", olDescending

I had it running a couple of days ago, but now it doesn’t run at all.
Although the results were somewhat incorrect, at least the code ran. I tried
to make a few small modifications, and now it doesn’t do anything at all.


Ken gave me the code below (thanks buddy).
The code below fails on this line:
Set colRestrict = myItems.Restrict("[Subject] = " & Chr(34) &
newTask.Subject & Chr(34))

…I made a small modification to Ken’s code and I’m ignoring any possibility
of word wrap as the culprit.

Sub DeleteDupes()
Set myNameSpace = GetNamespace("MAPI")
Set myFolder = myNameSpace.GetDefaultFolder(olFolderTasks)
Set myItems = myFolder.Items
Dim colRestrict As Outlook.Items
Set colRestrict = myItems.Restrict("[Subject] = " & Chr(34) &
newTask.Subject & Chr(34))
If colRestrict.Count = 0 Then ' no items with that Subject
'blah, blah, whatever
Else ' there is at least one dupe
' find the dupe and delete it
If colRestrict.Count = 1 Then
colRestrict.Items(1).Delete
Else
For i = colRestrict.Count To 1 Step -1
colRestrict.Items(i).Remove
Next
End If
End If
End Sub


Basically, I am trying to eliminate any and all duplicate Tasks in the Task
folder. I have some great experience doing VBA programming in an Excel
environment but virtually no experience doing VBA programming in an Outlook
environment, so I am at a huge disadvantage here. Can any Outlook expert
review these two Subs and find anything wrong here? I can’t figure out what
the problem is. :(

Regards,
Ryan--
Click to expand...
Click to expand...
Click to expand...
 
A

Aravind

What is the error?


Aravind

ryguy7272 said:
No...well it's not that easy. I tried several combinations of things, and
this causes an error on this line:
If ((newTask.Subject = oldTask.Subject)) Then

Any other ideas?
TIA!

--
RyGuy


Aravind said:
I haven't worked with Tasks yet, but isn't there a newtask.Delete?


Aravind

ryguy7272 said:
Good catch Aravind. Actually, I had no tasks in the Task Folder at the time.
Now with a few tasks in there, and two dupes, it seems to be counting the
items correctly, the only thing it does not do is delete the duplicate tasks
when the dupes are found and counted. I've narrowed the problem to this
snippet of code:

newTask.Mileage = "DELETEME"
iCounter = iCounter + 1
newTask.Save
End If
Set oldTask = newTask

I think the one line that is giving me problems is this:
Set oldTask = newTask

I tried things like this:
newTask.Subject = Remove

This removes the Subject from the Task (appropriate, right). What is the
code to remove the entire Task from the Task folder? I'm sooooo close to
resolving this; at this point I just need a little push.

Regards,
Ryan--

--
RyGuy


:

1 < 0 is always going to fail (i.e. return FALSE).


Aravind


:

The code below fails on this line:
While ((j < totalcount) And (myItems(j).Class <> olTask))

I put the cursor over j and see that Excel interprets it as 1, and I put the
cursor over totalcount and I see that Excel interprets it as 0; both of these
values seem correct to me.


Public Sub DeleteDuplicateTasks()

Dim oldTask As TaskItem, newTask As TaskItem, j As Integer
Dim iCounter As Integer

Set myNameSpace = GetNamespace("MAPI")
Set myFolder = myNameSpace.GetDefaultFolder(olFolderTasks)
Set myItems = myFolder.Items
'myItems.Sort "[File As]", olDescending
totalcount = myItems.Count
j = 1
While ((j < totalcount) And (myItems(j).Class <> olTask))
j = j + 1
Wend
Set oldTask = myItems(j)
For i = j + 1 To totalcount
If (myItems(i).Class = olTask) Then
'(newTask.Body = oldTask.Body) And _

Set newTask = myItems(i)
If ((newTask.Subject = oldTask.Subject)) Then
' (newTask.DueDate = oldTask.DueDate) And _

newTask.Mileage = "DELETEME"
iCounter = iCounter + 1
newTask.Save
End If
Set oldTask = newTask
End If
Next i
If iCounter = 0 Then
MsgBox "No duplicate Tasks were detected in " & totalcount & " Tasks!",
vbInformation, "No duplicates"
Else
MsgBox iCounter & " duplicate Tasks were detected and flagged!",
vbInformation, "Duplicates detected"
End If
End Sub

I found this code here:
http://www.outlookcode.com/threads.aspx?forumid=2&messageid=21714
I commented out this line:
'myItems.Sort "[File As]", olDescending

I had it running a couple of days ago, but now it doesn’t run at all.
Although the results were somewhat incorrect, at least the code ran. I tried
to make a few small modifications, and now it doesn’t do anything at all.


Ken gave me the code below (thanks buddy).
The code below fails on this line:
Set colRestrict = myItems.Restrict("[Subject] = " & Chr(34) &
newTask.Subject & Chr(34))

…I made a small modification to Ken’s code and I’m ignoring any possibility
of word wrap as the culprit.

Sub DeleteDupes()
Set myNameSpace = GetNamespace("MAPI")
Set myFolder = myNameSpace.GetDefaultFolder(olFolderTasks)
Set myItems = myFolder.Items
Dim colRestrict As Outlook.Items
Set colRestrict = myItems.Restrict("[Subject] = " & Chr(34) &
newTask.Subject & Chr(34))
If colRestrict.Count = 0 Then ' no items with that Subject
'blah, blah, whatever
Else ' there is at least one dupe
' find the dupe and delete it
If colRestrict.Count = 1 Then
colRestrict.Items(1).Delete
Else
For i = colRestrict.Count To 1 Step -1
colRestrict.Items(i).Remove
Next
End If
End If
End Sub


Basically, I am trying to eliminate any and all duplicate Tasks in the Task
folder. I have some great experience doing VBA programming in an Excel
environment but virtually no experience doing VBA programming in an Outlook
environment, so I am at a huge disadvantage here. Can any Outlook expert
review these two Subs and find anything wrong here? I can’t figure out what
the problem is. :(

Regards,
Ryan--
Click to expand...
Click to expand...
Click to expand...
 
K

Ken Slovak - [MVP - Outlook]

If you have a valid reference to an item, say a Task, then item.Delete
works. So does the Remove method of the Items collection, using an index
reference for Remove.

In that error are both oldTask and newTask instantiated (not Nothing or
null)? If one or both are null then trying to access .Subject would fail.
 
S

Sue Mosher [MVP-Outlook]

The only reason this blanks the subject is that Remove is an undeclared variable and so is treated as a null string. Add an Option Explicit statement to the declarations section of your code module to avoid being similarly misled in the future.

As Aravind said newTask.Delete would is the correct method to call to delete the item. And if you're just going to delete it, what's the point of changing the Mileage or Subject property?
 
R

ryguy7272

If I use this:
newtask.Delete

I get an error on this line:
If ((newTask.Subject = oldTask.Subject)) Then

....not found? Make any sense?

--
RyGuy


Aravind said:
What is the error?


Aravind

ryguy7272 said:
No...well it's not that easy. I tried several combinations of things, and
this causes an error on this line:
If ((newTask.Subject = oldTask.Subject)) Then

Any other ideas?
TIA!

--
RyGuy


Aravind said:
I haven't worked with Tasks yet, but isn't there a newtask.Delete?


Aravind

:

Good catch Aravind. Actually, I had no tasks in the Task Folder at the time.
Now with a few tasks in there, and two dupes, it seems to be counting the
items correctly, the only thing it does not do is delete the duplicate tasks
when the dupes are found and counted. I've narrowed the problem to this
snippet of code:

newTask.Mileage = "DELETEME"
iCounter = iCounter + 1
newTask.Save
End If
Set oldTask = newTask

I think the one line that is giving me problems is this:
Set oldTask = newTask

I tried things like this:
newTask.Subject = Remove

This removes the Subject from the Task (appropriate, right). What is the
code to remove the entire Task from the Task folder? I'm sooooo close to
resolving this; at this point I just need a little push.

Regards,
Ryan--

--
RyGuy


:

1 < 0 is always going to fail (i.e. return FALSE).


Aravind


:

The code below fails on this line:
While ((j < totalcount) And (myItems(j).Class <> olTask))

I put the cursor over j and see that Excel interprets it as 1, and I put the
cursor over totalcount and I see that Excel interprets it as 0; both of these
values seem correct to me.


Public Sub DeleteDuplicateTasks()

Dim oldTask As TaskItem, newTask As TaskItem, j As Integer
Dim iCounter As Integer

Set myNameSpace = GetNamespace("MAPI")
Set myFolder = myNameSpace.GetDefaultFolder(olFolderTasks)
Set myItems = myFolder.Items
'myItems.Sort "[File As]", olDescending
totalcount = myItems.Count
j = 1
While ((j < totalcount) And (myItems(j).Class <> olTask))
j = j + 1
Wend
Set oldTask = myItems(j)
For i = j + 1 To totalcount
If (myItems(i).Class = olTask) Then
'(newTask.Body = oldTask.Body) And _

Set newTask = myItems(i)
If ((newTask.Subject = oldTask.Subject)) Then
' (newTask.DueDate = oldTask.DueDate) And _

newTask.Mileage = "DELETEME"
iCounter = iCounter + 1
newTask.Save
End If
Set oldTask = newTask
End If
Next i
If iCounter = 0 Then
MsgBox "No duplicate Tasks were detected in " & totalcount & " Tasks!",
vbInformation, "No duplicates"
Else
MsgBox iCounter & " duplicate Tasks were detected and flagged!",
vbInformation, "Duplicates detected"
End If
End Sub

I found this code here:
http://www.outlookcode.com/threads.aspx?forumid=2&messageid=21714
I commented out this line:
'myItems.Sort "[File As]", olDescending

I had it running a couple of days ago, but now it doesn’t run at all.
Although the results were somewhat incorrect, at least the code ran. I tried
to make a few small modifications, and now it doesn’t do anything at all.


Ken gave me the code below (thanks buddy).
The code below fails on this line:
Set colRestrict = myItems.Restrict("[Subject] = " & Chr(34) &
newTask.Subject & Chr(34))

…I made a small modification to Ken’s code and I’m ignoring any possibility
of word wrap as the culprit.

Sub DeleteDupes()
Set myNameSpace = GetNamespace("MAPI")
Set myFolder = myNameSpace.GetDefaultFolder(olFolderTasks)
Set myItems = myFolder.Items
Dim colRestrict As Outlook.Items
Set colRestrict = myItems.Restrict("[Subject] = " & Chr(34) &
newTask.Subject & Chr(34))
If colRestrict.Count = 0 Then ' no items with that Subject
'blah, blah, whatever
Else ' there is at least one dupe
' find the dupe and delete it
If colRestrict.Count = 1 Then
colRestrict.Items(1).Delete
Else
For i = colRestrict.Count To 1 Step -1
colRestrict.Items(i).Remove
Next
End If
End If
End Sub


Basically, I am trying to eliminate any and all duplicate Tasks in the Task
folder. I have some great experience doing VBA programming in an Excel
environment but virtually no experience doing VBA programming in an Outlook
environment, so I am at a huge disadvantage here. Can any Outlook expert
review these two Subs and find anything wrong here? I can’t figure out what
the problem is. :(

Regards,
Ryan--
Click to expand...
Click to expand...
Click to expand...
 
S

Sue Mosher [MVP-Outlook]

If you delete the item, it's not going to around any more to have its subject changed. Why would you want to change the subject of a deleted item anyway?

--
Sue Mosher, Outlook MVP
Author of Microsoft Outlook 2007 Programming:
Jumpstart for Power Users and Administrators
http://www.outlookcode.com/article.aspx?id=54


ryguy7272 said:
If I use this:
newtask.Delete

I get an error on this line:
If ((newTask.Subject = oldTask.Subject)) Then

...not found? Make any sense?

--
RyGuy


Aravind said:
What is the error?


Aravind

ryguy7272 said:
No...well it's not that easy. I tried several combinations of things, and
this causes an error on this line:
If ((newTask.Subject = oldTask.Subject)) Then

Any other ideas?
TIA!

--
RyGuy


:

I haven't worked with Tasks yet, but isn't there a newtask.Delete?


Aravind

:

Good catch Aravind. Actually, I had no tasks in the Task Folder at the time.
Now with a few tasks in there, and two dupes, it seems to be counting the
items correctly, the only thing it does not do is delete the duplicate tasks
when the dupes are found and counted. I've narrowed the problem to this
snippet of code:

newTask.Mileage = "DELETEME"
iCounter = iCounter + 1
newTask.Save
End If
Set oldTask = newTask

I think the one line that is giving me problems is this:
Set oldTask = newTask

I tried things like this:
newTask.Subject = Remove

This removes the Subject from the Task (appropriate, right). What is the
code to remove the entire Task from the Task folder? I'm sooooo close to
resolving this; at this point I just need a little push.

Regards,
Ryan--

--
RyGuy


:

1 < 0 is always going to fail (i.e. return FALSE).


Aravind


:

The code below fails on this line:
While ((j < totalcount) And (myItems(j).Class <> olTask))

I put the cursor over j and see that Excel interprets it as 1, and I put the
cursor over totalcount and I see that Excel interprets it as 0; both of these
values seem correct to me.


Public Sub DeleteDuplicateTasks()

Dim oldTask As TaskItem, newTask As TaskItem, j As Integer
Dim iCounter As Integer

Set myNameSpace = GetNamespace("MAPI")
Set myFolder = myNameSpace.GetDefaultFolder(olFolderTasks)
Set myItems = myFolder.Items
'myItems.Sort "[File As]", olDescending
totalcount = myItems.Count
j = 1
While ((j < totalcount) And (myItems(j).Class <> olTask))
j = j + 1
Wend
Set oldTask = myItems(j)
For i = j + 1 To totalcount
If (myItems(i).Class = olTask) Then
'(newTask.Body = oldTask.Body) And _

Set newTask = myItems(i)
If ((newTask.Subject = oldTask.Subject)) Then
' (newTask.DueDate = oldTask.DueDate) And _

newTask.Mileage = "DELETEME"
iCounter = iCounter + 1
newTask.Save
End If
Set oldTask = newTask
End If
Next i
If iCounter = 0 Then
MsgBox "No duplicate Tasks were detected in " & totalcount & " Tasks!",
vbInformation, "No duplicates"
Else
MsgBox iCounter & " duplicate Tasks were detected and flagged!",
vbInformation, "Duplicates detected"
End If
End Sub

I found this code here:
http://www.outlookcode.com/threads.aspx?forumid=2&messageid=21714
I commented out this line:
'myItems.Sort "[File As]", olDescending

I had it running a couple of days ago, but now it doesn’t run at all.
Although the results were somewhat incorrect, at least the code ran. I tried
to make a few small modifications, and now it doesn’t do anything at all.


Ken gave me the code below (thanks buddy).
The code below fails on this line:
Set colRestrict = myItems.Restrict("[Subject] = " & Chr(34) &
newTask.Subject & Chr(34))

…I made a small modification to Ken’s code and I’m ignoring any possibility
of word wrap as the culprit.

Sub DeleteDupes()
Set myNameSpace = GetNamespace("MAPI")
Set myFolder = myNameSpace.GetDefaultFolder(olFolderTasks)
Set myItems = myFolder.Items
Dim colRestrict As Outlook.Items
Set colRestrict = myItems.Restrict("[Subject] = " & Chr(34) &
newTask.Subject & Chr(34))
If colRestrict.Count = 0 Then ' no items with that Subject
'blah, blah, whatever
Else ' there is at least one dupe
' find the dupe and delete it
If colRestrict.Count = 1 Then
colRestrict.Items(1).Delete
Else
For i = colRestrict.Count To 1 Step -1
colRestrict.Items(i).Remove
Next
End If
End If
End Sub


Basically, I am trying to eliminate any and all duplicate Tasks in the Task
folder. I have some great experience doing VBA programming in an Excel
environment but virtually no experience doing VBA programming in an Outlook
environment, so I am at a huge disadvantage here. Can any Outlook expert
review these two Subs and find anything wrong here? I can’t figure out what
the problem is. :(

Regards,
Ryan--
Click to expand...
Click to expand...
Click to expand...
 
R

ryguy7272

Well, I finally got it working. There seemed to be a problem with the
iCounter at one point; I think that has been resolved. Also, an error kept
coming up; I added a small line of code in an attempt to manage the error. I
may test it a little more, but it appears to function fine after several
trials. Thanks to everyone!!



Sub GetOutlookReference()

Setwarnings = False
'Outlook objects
Dim olApp As Outlook.Application

'Obtain a reference to Outlook
On Error Resume Next
Set olApp = GetObject(, "Outlook.Application")

'*********************************************
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim l As Integer

i = 2
j = 2
k = 2
l = 2

Do Until Cells(i, 5).Value = ""
'*********************************************
Dim objApp As Object
Dim OutTask As Object

Set objApp = CreateObject("Outlook.Application")
'Set objOutlookApp = Application
Set OutTask = objApp.CreateItem(olTaskItem)
With OutTask
.StartDate = Cells(i, 5).Value
.Subject = Cells(j, 3).Value
.Body = Cells(k, 1).Value & " - " & Cells(l, 4).Value
.Importance = olImportanceHigh
'.Display
.ReminderSet = True
'.ReminderTime = [NextPM]
'.DueDate = [NextPM]
'.ReminderPlaySound = True
'.ReminderSoundFile = "C:\WINNT\Media\Ding.wav"
.Save
'.Close
End With
'*********************************************
l = l + 1
k = k + 1
j = j + 1
i = i + 1
Loop

'If Outlook isn't running, start it and remember
If olApp Is Nothing Then
'Set olApp = CreateObject("Outlook.Application")
Set objOutlook = Application
End If

' If Outlook still isn't running, Outlook cannot open or is not installed
If olApp Is Nothing Then
Call MsgBox("Outlook could not be opened. Exiting macro.", _
vbCritical, Application.Name)
End If

'Send the emial from here
If Range("J1").Value >= Range("I1").Value Then

Dim FileExtStr As String
Dim FileFormatNum As Long
Dim Sourcewb As Workbook
Dim Destwb As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim OutApp As Object
Dim OutMail As Object

With Application
.ScreenUpdating = False
.EnableEvents = False
End With

Set Sourcewb = ActiveWorkbook

'Copy the sheet to a new workbook
ActiveSheet.Copy
Set Destwb = ActiveWorkbook


With Destwb
If Val(Application.Version) < 12 Then

FileExtStr = ".xls": FileFormatNum = -4143
Else

If Sourcewb.Name = .Name Then
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
MsgBox "Your answer is NO in the security dialog"
Exit Sub
Else
Select Case Sourcewb.FileFormat
Case 51: FileExtStr = ".xlsx": FileFormatNum = 51
Case 52:
If .HasVBProject Then
FileExtStr = ".xlsm": FileFormatNum = 52
Else
FileExtStr = ".xlsx": FileFormatNum = 51
End If
Case 56: FileExtStr = ".xls": FileFormatNum = 56
Case Else: FileExtStr = ".xlsb": FileFormatNum = 50
End Select
End If
End If
End With


'Save the new workbook/Mail it/Delete it
TempFilePath = Environ$("temp") & "\"
TempFileName = "Part of " & Sourcewb.Name & " " & Format(Now, "dd-mmm-yy
h-mm-ss")

Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon
Set OutMail = OutApp.CreateItem(0)

With Destwb
.SaveAs TempFilePath & TempFileName & FileExtStr,
FileFormat:=FileFormatNum
On Error Resume Next
With OutMail
.To = "[email protected]" '& ""
.CC = ""
.BCC = ""
.Subject = "Task Roll Ups"
.Body = "Please see attached..."
.Attachments.Add Destwb.FullName
'.Attachments.Add ("C:\test.txt")
.Send 'or use .Display
End With
On Error GoTo 0
.Close SaveChanges:=False
End With

'Delete the file you have send
Kill TempFilePath & TempFileName & FileExtStr

Set OutMail = Nothing
Set OutApp = Nothing

With Application
.ScreenUpdating = True
.EnableEvents = True
End With

End If
Call DeleteDuplicateTask

End Sub


Public Sub DeleteDuplicateTasks()

Dim oldTask As TaskItem, newTask As TaskItem, j As Integer
Dim iCounter As Integer

Set myNameSpace = GetNamespace("MAPI")
Set myFolder = myNameSpace.GetDefaultFolder(olFolderTasks)
Set myItems = myFolder.Items
'myItems.Sort "[File As]", olDescending
totalcount = myItems.Count
j = 1
While ((j < totalcount) And (myItems(j).Class <> olTask))
j = j + 1
Wend
Set oldTask = myItems(j)
For i = j + 1 To totalcount
On Error GoTo Here
If (myItems(i).Class = olTask) Then
'(newTask.Body = oldTask.Body) And _

Set newTask = myItems(i)
If ((newTask.Subject = oldTask.Subject)) Then
' (newTask.DueDate = oldTask.DueDate) And _

newTask.Mileage = "DELETEME"
iCounter = iCounter + 1
newTask.Save
End If
newTask.Delete
End If
Next i

Here:
If iCounter = 0 Then
MsgBox "No duplicate Tasks were detected in " & totalcount & " Tasks!",
vbInformation, "No duplicates"
Else
MsgBox "Duplicate Tasks were detected and deleted!", vbInformation,
"Duplicates detected"
'MsgBox iCounter & " duplicate Tasks were detected and flagged!",
vbInformation, "Duplicates detected"
End If
End Sub

'*********************************** End of code ***
 
K

Ken Slovak - [MVP - Outlook]

If this code is running in Excel then any reference to Application will mean
Excel.Application, not Outlook.Application. The VBA intrinsic Application
object refers to the application that VBA is running under.




ryguy7272 said:
Well, I finally got it working. There seemed to be a problem with the
iCounter at one point; I think that has been resolved. Also, an error
kept
coming up; I added a small line of code in an attempt to manage the error.
I
may test it a little more, but it appears to function fine after several
trials. Thanks to everyone!!



Sub GetOutlookReference()

Setwarnings = False
'Outlook objects
Dim olApp As Outlook.Application

'Obtain a reference to Outlook
On Error Resume Next
Set olApp = GetObject(, "Outlook.Application")

'*********************************************
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim l As Integer

i = 2
j = 2
k = 2
l = 2

Do Until Cells(i, 5).Value = ""
'*********************************************
Dim objApp As Object
Dim OutTask As Object

Set objApp = CreateObject("Outlook.Application")
'Set objOutlookApp = Application
Set OutTask = objApp.CreateItem(olTaskItem)
With OutTask
.StartDate = Cells(i, 5).Value
.Subject = Cells(j, 3).Value
.Body = Cells(k, 1).Value & " - " & Cells(l, 4).Value
.Importance = olImportanceHigh
'.Display
.ReminderSet = True
'.ReminderTime = [NextPM]
'.DueDate = [NextPM]
'.ReminderPlaySound = True
'.ReminderSoundFile = "C:\WINNT\Media\Ding.wav"
.Save
'.Close
End With
'*********************************************
l = l + 1
k = k + 1
j = j + 1
i = i + 1
Loop

'If Outlook isn't running, start it and remember
If olApp Is Nothing Then
'Set olApp = CreateObject("Outlook.Application")
Set objOutlook = Application
End If

' If Outlook still isn't running, Outlook cannot open or is not installed
If olApp Is Nothing Then
Call MsgBox("Outlook could not be opened. Exiting macro.", _
vbCritical, Application.Name)
End If

'Send the emial from here
If Range("J1").Value >= Range("I1").Value Then

Dim FileExtStr As String
Dim FileFormatNum As Long
Dim Sourcewb As Workbook
Dim Destwb As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim OutApp As Object
Dim OutMail As Object

With Application
.ScreenUpdating = False
.EnableEvents = False
End With

Set Sourcewb = ActiveWorkbook

'Copy the sheet to a new workbook
ActiveSheet.Copy
Set Destwb = ActiveWorkbook


With Destwb
If Val(Application.Version) < 12 Then

FileExtStr = ".xls": FileFormatNum = -4143
Else

If Sourcewb.Name = .Name Then
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
MsgBox "Your answer is NO in the security dialog"
Exit Sub
Else
Select Case Sourcewb.FileFormat
Case 51: FileExtStr = ".xlsx": FileFormatNum = 51
Case 52:
If .HasVBProject Then
FileExtStr = ".xlsm": FileFormatNum = 52
Else
FileExtStr = ".xlsx": FileFormatNum = 51
End If
Case 56: FileExtStr = ".xls": FileFormatNum = 56
Case Else: FileExtStr = ".xlsb": FileFormatNum = 50
End Select
End If
End If
End With


'Save the new workbook/Mail it/Delete it
TempFilePath = Environ$("temp") & "\"
TempFileName = "Part of " & Sourcewb.Name & " " & Format(Now,
"dd-mmm-yy
h-mm-ss")

Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon
Set OutMail = OutApp.CreateItem(0)

With Destwb
.SaveAs TempFilePath & TempFileName & FileExtStr,
FileFormat:=FileFormatNum
On Error Resume Next
With OutMail
.To = "[email protected]" '& ""
.CC = ""
.BCC = ""
.Subject = "Task Roll Ups"
.Body = "Please see attached..."
.Attachments.Add Destwb.FullName
'.Attachments.Add ("C:\test.txt")
.Send 'or use .Display
End With
On Error GoTo 0
.Close SaveChanges:=False
End With

'Delete the file you have send
Kill TempFilePath & TempFileName & FileExtStr

Set OutMail = Nothing
Set OutApp = Nothing

With Application
.ScreenUpdating = True
.EnableEvents = True
End With

End If
Call DeleteDuplicateTask

End Sub


Public Sub DeleteDuplicateTasks()

Dim oldTask As TaskItem, newTask As TaskItem, j As Integer
Dim iCounter As Integer

Set myNameSpace = GetNamespace("MAPI")
Set myFolder = myNameSpace.GetDefaultFolder(olFolderTasks)
Set myItems = myFolder.Items
'myItems.Sort "[File As]", olDescending
totalcount = myItems.Count
j = 1
While ((j < totalcount) And (myItems(j).Class <> olTask))
j = j + 1
Wend
Set oldTask = myItems(j)
For i = j + 1 To totalcount
On Error GoTo Here
If (myItems(i).Class = olTask) Then
'(newTask.Body = oldTask.Body) And _

Set newTask = myItems(i)
If ((newTask.Subject = oldTask.Subject)) Then
' (newTask.DueDate = oldTask.DueDate) And _

newTask.Mileage = "DELETEME"
iCounter = iCounter + 1
newTask.Save
End If
newTask.Delete
End If
Next i

Here:
If iCounter = 0 Then
MsgBox "No duplicate Tasks were detected in " & totalcount & " Tasks!",
vbInformation, "No duplicates"
Else
MsgBox "Duplicate Tasks were detected and deleted!", vbInformation,
"Duplicates detected"
'MsgBox iCounter & " duplicate Tasks were detected and flagged!",
vbInformation, "Duplicates detected"
End If
End Sub

'*********************************** End of code ***
Click to expand...
 
R

ryguy7272

Yes, Ken, you are 100% correct. I think I compensated appropriately with
this line:
Set OutApp = CreateObject("Outlook.Application")

That's what I'm using; I think that's right.


Thanks for everything!
Ryan--

--
RyGuy


Ken Slovak - said:
If this code is running in Excel then any reference to Application will mean
Excel.Application, not Outlook.Application. The VBA intrinsic Application
object refers to the application that VBA is running under.




ryguy7272 said:
Well, I finally got it working. There seemed to be a problem with the
iCounter at one point; I think that has been resolved. Also, an error
kept
coming up; I added a small line of code in an attempt to manage the error.
I
may test it a little more, but it appears to function fine after several
trials. Thanks to everyone!!



Sub GetOutlookReference()

Setwarnings = False
'Outlook objects
Dim olApp As Outlook.Application

'Obtain a reference to Outlook
On Error Resume Next
Set olApp = GetObject(, "Outlook.Application")

'*********************************************
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim l As Integer

i = 2
j = 2
k = 2
l = 2

Do Until Cells(i, 5).Value = ""
'*********************************************
Dim objApp As Object
Dim OutTask As Object

Set objApp = CreateObject("Outlook.Application")
'Set objOutlookApp = Application
Set OutTask = objApp.CreateItem(olTaskItem)
With OutTask
.StartDate = Cells(i, 5).Value
.Subject = Cells(j, 3).Value
.Body = Cells(k, 1).Value & " - " & Cells(l, 4).Value
.Importance = olImportanceHigh
'.Display
.ReminderSet = True
'.ReminderTime = [NextPM]
'.DueDate = [NextPM]
'.ReminderPlaySound = True
'.ReminderSoundFile = "C:\WINNT\Media\Ding.wav"
.Save
'.Close
End With
'*********************************************
l = l + 1
k = k + 1
j = j + 1
i = i + 1
Loop

'If Outlook isn't running, start it and remember
If olApp Is Nothing Then
'Set olApp = CreateObject("Outlook.Application")
Set objOutlook = Application
End If

' If Outlook still isn't running, Outlook cannot open or is not installed
If olApp Is Nothing Then
Call MsgBox("Outlook could not be opened. Exiting macro.", _
vbCritical, Application.Name)
End If

'Send the emial from here
If Range("J1").Value >= Range("I1").Value Then

Dim FileExtStr As String
Dim FileFormatNum As Long
Dim Sourcewb As Workbook
Dim Destwb As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim OutApp As Object
Dim OutMail As Object

With Application
.ScreenUpdating = False
.EnableEvents = False
End With

Set Sourcewb = ActiveWorkbook

'Copy the sheet to a new workbook
ActiveSheet.Copy
Set Destwb = ActiveWorkbook


With Destwb
If Val(Application.Version) < 12 Then

FileExtStr = ".xls": FileFormatNum = -4143
Else

If Sourcewb.Name = .Name Then
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
MsgBox "Your answer is NO in the security dialog"
Exit Sub
Else
Select Case Sourcewb.FileFormat
Case 51: FileExtStr = ".xlsx": FileFormatNum = 51
Case 52:
If .HasVBProject Then
FileExtStr = ".xlsm": FileFormatNum = 52
Else
FileExtStr = ".xlsx": FileFormatNum = 51
End If
Case 56: FileExtStr = ".xls": FileFormatNum = 56
Case Else: FileExtStr = ".xlsb": FileFormatNum = 50
End Select
End If
End If
End With


'Save the new workbook/Mail it/Delete it
TempFilePath = Environ$("temp") & "\"
TempFileName = "Part of " & Sourcewb.Name & " " & Format(Now,
"dd-mmm-yy
h-mm-ss")

Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon
Set OutMail = OutApp.CreateItem(0)

With Destwb
.SaveAs TempFilePath & TempFileName & FileExtStr,
FileFormat:=FileFormatNum
On Error Resume Next
With OutMail
.To = "[email protected]" '& ""
.CC = ""
.BCC = ""
.Subject = "Task Roll Ups"
.Body = "Please see attached..."
.Attachments.Add Destwb.FullName
'.Attachments.Add ("C:\test.txt")
.Send 'or use .Display
End With
On Error GoTo 0
.Close SaveChanges:=False
End With

'Delete the file you have send
Kill TempFilePath & TempFileName & FileExtStr

Set OutMail = Nothing
Set OutApp = Nothing

With Application
.ScreenUpdating = True
.EnableEvents = True
End With

End If
Call DeleteDuplicateTask

End Sub


Public Sub DeleteDuplicateTasks()

Dim oldTask As TaskItem, newTask As TaskItem, j As Integer
Dim iCounter As Integer

Set myNameSpace = GetNamespace("MAPI")
Set myFolder = myNameSpace.GetDefaultFolder(olFolderTasks)
Set myItems = myFolder.Items
'myItems.Sort "[File As]", olDescending
totalcount = myItems.Count
j = 1
While ((j < totalcount) And (myItems(j).Class <> olTask))
j = j + 1
Wend
Set oldTask = myItems(j)
For i = j + 1 To totalcount
On Error GoTo Here
If (myItems(i).Class = olTask) Then
'(newTask.Body = oldTask.Body) And _

Set newTask = myItems(i)
If ((newTask.Subject = oldTask.Subject)) Then
' (newTask.DueDate = oldTask.DueDate) And _

newTask.Mileage = "DELETEME"
iCounter = iCounter + 1
newTask.Save
End If
newTask.Delete
End If
Next i

Here:
If iCounter = 0 Then
MsgBox "No duplicate Tasks were detected in " & totalcount & " Tasks!",
vbInformation, "No duplicates"
Else
MsgBox "Duplicate Tasks were detected and deleted!", vbInformation,
"Duplicates detected"
'MsgBox iCounter & " duplicate Tasks were detected and flagged!",
vbInformation, "Duplicates detected"
End If
End Sub

'*********************************** End of code ***
Click to expand...
Click to expand...
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Help with Code - Creating Status Report from Task items 1

Top