Processing attachments script needs improvements

I receive a couple hundred emails at the end of each month that contain Excel attachments that I use the posted script to: check for Excel attachments, then if present, check to see if the Excel attachment contains the worksheet that I want - if it does, saves the attachment to the specified folder as Sendername_G22.xls.  This script works, but for example, if there are say 100 emails in the Inbox when it is run, the first time it's run, it process maybe 50 - 60 of them, then when I rerun the script, it will process maybe 25 or so.  It seems to process fewer emails each time that it is run.  So, it seems that maybe its a memory issue or something.

I am hoping that someone can look at this and tell me how what is happening and how to improve it.  Any help will be appreciated.  Thanks.

Sub G22EmailNYC()
    'Declare Outlook objects
    
    Dim OlApp As New Outlook.Application
    Dim NS As Outlook.NameSpace
    Dim Inbox As Outlook.MAPIFolder
    Dim olfldDest As Outlook.MAPIFolder
    Dim olItems As Outlook.Items
    Dim olItem As Object
    Dim olAttachment As Outlook.Attachment
    Dim oRecip As Outlook.Recipient
    Dim nycInbox As MAPIFolder
       
    
    
    'Declare Excel and FSO objects
    Dim objFSO As Object
    Dim objTempFolder As Object
    Dim strRootFolderPath As String
    Dim strFilename As String
    Dim intCount As Integer
    Dim FileCount As Integer
    Dim excApp As Object
    Dim excBook As Object
    Dim excSheet As Object
    
    
    MsgBox "This procedure will scan the inbox of NYCReport, 1NYCReports, & 2NYCReports email accounts for Officer Stats workbooks and when found save the attached reports in the format 'SenderName_G22.xls' in \\Z02RSCNYC03\SHARE$\NYC Reports\G-22_Monthly_Stats\FY09\NYC\2_Email ", vbInformation, "Search for Stats Reports"
    'MsgBox "This procedure will scan the inbox of NYCReports email for Officer Stats workbooks and when found save the attached reports in the format 'SenderName_G22.xls' in \\Z02RSCNYC03\SHARE$\NYC Reports\G-22_Monthly_Stats\FY09\NYC\2_Email ", vbInformation, "Search for Stats Reports"
    'Set Outlook variables
    Set NS = OlApp.GetNamespace("MAPI")
    Set oRecip = NS.CreateRecipient("nycreport")
    If oRecip.Resolve() Then
    Set nycInbox = NS.GetSharedDefaultFolder(oRecip, olFolderInbox)
    Else
    MsgBox "nyc Report mailbox is not accessible"
    Exit Sub
    End If
    Set olItems = nycInbox.Items
    'Used to select Destination Folder for email manually
    'Set olfldDest = NS.PickFolder
    'We'll set the email destination for mail containing G22 workbooks to Inbox\G22_Stats_Temp
    Set olfldDest = nycInbox.Folders("G22_Stats_temp") ' Enter correct subfolder name.
    'Set FSO variables
  Set objFSO = CreateObject("Scripting.FileSystemObject")
  Set objTempFolder = objFSO.GetSpecialFolder(2)
    strRootFolderPath = "\\Z02RSCNYC03\SHARE$\NYC Reports\G-22_Monthly_Stats\FY09\NYC\2_Email\"
    FileCount = 0
    'Look through the Inbox mail
    For Each olItem In olItems
            'Look only at items with attachments
            If olItem.Attachments.Count > 0 Then
                    For Each olAttachment In olItem.Attachments
                        'This line sets the criteria to all files with the xls extension
                        If objFSO.GetExtensionName(LCase(olAttachment.FileName)) = "xls" Then
                                strFilename = olItem.SenderName
                                On Error Resume Next
                                olAttachment.SaveAsFile objTempFolder.Path & "\" & strFilename
                                On Error GoTo 0
                'Set Excel variables so we can manipulate Excel attachments
                Set excApp = CreateObject("Excel.Application")
                Set excBook = excApp.Workbooks.Open(objTempFolder.Path & "\" & strFilename)
                'Look for the Data-Review Sheet
                On Error Resume Next
                Set excSheet = excBook.Sheets("Data-Review")
                On Error GoTo RESET
                                If TypeName(excSheet) <> "Nothing" Then
                                        intCount = 0
                                        Do While True
                                   If objFSO.FileExists(strRootFolderPath & strFilename) Then
                            intCount = intCount + 1
                            strFilename = strFilename & "_Copy" & intCount & "_G22.xls"
                                                Else
                                                        Exit Do
                                                End If
                    Loop
                    olAttachment.SaveAsFile strRootFolderPath & strFilename & "_G22.xls"
                    FileCount = FileCount + 1
                    olItem.Move olfldDest
                    olItem.UnRead = False
                    olItem.Save
                End If
RESET:
                Set excSheet = Nothing
                excBook.Close False
                Set excBook = Nothing
                excApp.Quit
                Set excApp = Nothing
        End If
            Next
    End If
    Next
    MsgBox "Email check is complete,  " & FileCount & "  Stats Files have been saved."
    Set NS = Nothing
    Set Inbox = Nothing
    Set olItems = Nothing
    Set olfldDest = Nothing
    Set objFSO = Nothing
    Set olAttachment = Nothing
    Set objTempFolder = Nothing
 
End Sub

Select allOpen in new window