dewdrop_worl
12-02-2005, 09:01 AM
Sorry if this has been asked before... I searched this forum for "slow" but didn't see anything relevant.
In Outlook 2000, I set up a bunch of macros that help me organize my folders and delete messages I don't need anymore. I just upgraded to Office 2003 and I find that the same macros are running about 20 times slower. :eek:
Did a little tracing in the VBA editor... whenever I'm trying to get items out of a MAPIFolder, there's a noticeable delay. In 2000, I could hit F8 on a line like this in the response would be practically immediate, some small number of milliseconds.
If InStr(myFolder.Items(i).Subject, SubjText) > 0 Then
In 2003, there's a noticeable lag, sometimes 0.1s, sometimes 0.25s, once or twice it might take five or more seconds. Multiply that by 80 messages in a folder and you have a macro that used to take 2-3 seconds that now takes 30-60 seconds. Totally unusable. One of them is Application_NewMail(), so it really really hurts.
I really depend on these macros, but I have no idea why the performance is so crappy. Does anyone know?
Here's the new mail macro:
Private Sub Application_NewMail()
Call DeleteOldPendings
End Sub
Sub DeleteOldPendings()
Call DeleteOldContaining("Hourly Pendings")
Call DeleteOldContaining("Hourly Teams")
End Sub
Private Sub DeleteOldContaining(SubjText As String)
Dim myFolder As Outlook.MAPIFolder
Dim HourlyPendings(200) As MailItem
Dim LatestTime As Date
Set myFolder = CreateObject("Outlook.application").GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)
'Debug.Print Time, "Executing DeleteOldPendings."
' search for latest "hourly pendings"
j = 0
LatestTime = #1/1/1950#
For i = 1 To myFolder.Items.Count
' this line is slow!!
If InStr(myFolder.Items(i).Subject, SubjText) > 0 Then
j = j + 1
Set HourlyPendings(j) = myFolder.Items(i)
' this one too
If myFolder.Items(i).ReceivedTime > LatestTime Then LatestTime = myFolder.Items(i).ReceivedTime
End If
Next i
' now delete all except latest
For i = 1 To j
' I'm pretty sure these lines will be slow also, but I haven't traced them
If HourlyPendings(i).ReceivedTime < LatestTime Then
HourlyPendings(i).Delete
End If
Next i
'Debug.Print Time, "Finished DeleteOldPendings."
End Sub
Thanks!
hjh
In Outlook 2000, I set up a bunch of macros that help me organize my folders and delete messages I don't need anymore. I just upgraded to Office 2003 and I find that the same macros are running about 20 times slower. :eek:
Did a little tracing in the VBA editor... whenever I'm trying to get items out of a MAPIFolder, there's a noticeable delay. In 2000, I could hit F8 on a line like this in the response would be practically immediate, some small number of milliseconds.
If InStr(myFolder.Items(i).Subject, SubjText) > 0 Then
In 2003, there's a noticeable lag, sometimes 0.1s, sometimes 0.25s, once or twice it might take five or more seconds. Multiply that by 80 messages in a folder and you have a macro that used to take 2-3 seconds that now takes 30-60 seconds. Totally unusable. One of them is Application_NewMail(), so it really really hurts.
I really depend on these macros, but I have no idea why the performance is so crappy. Does anyone know?
Here's the new mail macro:
Private Sub Application_NewMail()
Call DeleteOldPendings
End Sub
Sub DeleteOldPendings()
Call DeleteOldContaining("Hourly Pendings")
Call DeleteOldContaining("Hourly Teams")
End Sub
Private Sub DeleteOldContaining(SubjText As String)
Dim myFolder As Outlook.MAPIFolder
Dim HourlyPendings(200) As MailItem
Dim LatestTime As Date
Set myFolder = CreateObject("Outlook.application").GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)
'Debug.Print Time, "Executing DeleteOldPendings."
' search for latest "hourly pendings"
j = 0
LatestTime = #1/1/1950#
For i = 1 To myFolder.Items.Count
' this line is slow!!
If InStr(myFolder.Items(i).Subject, SubjText) > 0 Then
j = j + 1
Set HourlyPendings(j) = myFolder.Items(i)
' this one too
If myFolder.Items(i).ReceivedTime > LatestTime Then LatestTime = myFolder.Items(i).ReceivedTime
End If
Next i
' now delete all except latest
For i = 1 To j
' I'm pretty sure these lines will be slow also, but I haven't traced them
If HourlyPendings(i).ReceivedTime < LatestTime Then
HourlyPendings(i).Delete
End If
Next i
'Debug.Print Time, "Finished DeleteOldPendings."
End Sub
Thanks!
hjh