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.
'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)
MsgBox "nyc Report mailbox is not accessible"
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"
olAttachment.SaveAsFile strRootFolderPath & strFilename & "_G22.xls"
FileCount = FileCount + 1
olItem.UnRead = False
Set excSheet = Nothing
Set excBook = Nothing
Set excApp = Nothing
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