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--
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--