Optimize subroutine.. make it better

Tech Tip: Click here to run a free scan for Windows Errors and optimize PC performance

From: Matt Williamson (ih8spam_at_spamsux.org)
Date: 02/11/04 

Date: Wed, 11 Feb 2004 14:11:43 -0500

I have the following subroutine that loops through outlook folders and
parses out 9 digit alphanumeric values. I'm trying to clean up the code
becasue there is some redundancy in it, but I can't figure out the best way
to do so. If anyone can offer some advice, I'd appreciate it

The For Each blocks are essentially the same and I know there is a way to
combine it together, but I can't figure it out easily. I wrote it this way
just to get it to work, but I'd like to eliminate the extra code that
doesn't need to be repeated.

'\\ Global Form level variables:

Dim objOutlook As Outlook.Application
Dim objNameSpace As Outlook.NameSpace
Dim objInboxFolder As Outlook.MAPIFolder
Dim objSavedMessages As Outlook.MAPIFolder
Dim objMailItem As Outlook.MailItem
Dim objFolders As Outlook.Folders
Dim objFolder As Outlook.MAPIFolder

'\\ Form Code

Private Sub GetCusipsFromEmailRevised()

Dim dtCurrentDate As Date

List1.Clear

Dim sSplit As String
Dim sString() As String

Set objOutlook = Outlook.Application
Set objNameSpace = objOutlook.GetNamespace("MAPI")
Set objInboxFolder = objNameSpace.GetDefaultFolder(olFolderInbox)

If cboFromFolder.Text = "Inbox" Then
  'Inbox itself
  For Each objMailItem In objInboxFolder.Items
      Debug.Print objMailItem
      DoEvents
      Me.MousePointer = vbArrowHourglass
      dtCurrentDate = Split(objMailItem.ReceivedTime, " ")(0)
        If (dtp(0).Value <= dtCurrentDate And dtp(1).Value >= dtCurrentDate)
Xor _
           optDates(1).Value = False Then
            ParseCusip objMailItem
        Else: Exit For
        End If
  Next objMailItem

Else
 'Subfolder of Inbox
  For Each objMailItem In objInboxFolder.Folders(cboFromFolder.Text).Items
      Debug.Print objMailItem
      DoEvents
      Me.MousePointer = vbArrowHourglass
      dtCurrentDate = Split(objMailItem.ReceivedTime, " ")(0)
        If (dtp(0).Value <= dtCurrentDate And dtp(1).Value >= dtCurrentDate)
Xor _
           optDates(1).Value = False Then
            ParseCusip objMailItem
        Else: Exit For
        End If
  Next objMailItem

End If

Me.MousePointer = vbArrow

Set objInboxFolder = Nothing
Set objNameSpace = Nothing
Set objOutlook = Nothing

End Sub

TIA

Matt

Relevant Pages