G
Guest
I'm trying somehow to imitate Gmail feature, which moves archived items back
into the Inbox when a new email with the same subject line arrives.
I have implemented following which will be called each time an email arrives
and moves all emails with same Conversation topic back to the Inbox. It seems
to work, but takes very long with only 1400 items in my Archive folder. Any
idea how I can speed this up?
Thanks
Kemal
Sub Test()
MoveEmails ("Considered test defects")
End Sub
Sub MoveEmails(myConvTopic As String)
Dim persFolders, myArchiveFolder, myDestFolder As Outlook.MAPIFolder
Dim i As Integer
Dim myItem As Outlook.MailItem
Set myDestFolder = Application.Session.GetDefaultFolder(olFolderInbox)
Set persFolders = Application.Session.Folders.Item(3)
Set myArchiveFolder = persFolders.Folders.Item(7)
mailCount = myArchiveFolder.Items.Count
For i = mailCount To 1 Step -1
If myArchiveFolder.Items(i).Class = olMail Then
Set myItem = myArchiveFolder.Items(i)
If myItem.ConversationTopic = myConvTopic Then
myItem.Move myDestFolder
End If
End If
Next
End Sub
into the Inbox when a new email with the same subject line arrives.
I have implemented following which will be called each time an email arrives
and moves all emails with same Conversation topic back to the Inbox. It seems
to work, but takes very long with only 1400 items in my Archive folder. Any
idea how I can speed this up?
Thanks
Kemal
Sub Test()
MoveEmails ("Considered test defects")
End Sub
Sub MoveEmails(myConvTopic As String)
Dim persFolders, myArchiveFolder, myDestFolder As Outlook.MAPIFolder
Dim i As Integer
Dim myItem As Outlook.MailItem
Set myDestFolder = Application.Session.GetDefaultFolder(olFolderInbox)
Set persFolders = Application.Session.Folders.Item(3)
Set myArchiveFolder = persFolders.Folders.Item(7)
mailCount = myArchiveFolder.Items.Count
For i = mailCount To 1 Step -1
If myArchiveFolder.Items(i).Class = olMail Then
Set myItem = myArchiveFolder.Items(i)
If myItem.ConversationTopic = myConvTopic Then
myItem.Move myDestFolder
End If
End If
Next
End Sub