PDA

View Full Version : Solved: Array index out of bounds HELP!



telepicker
04-07-2011, 08:43 AM
I have the following code built with the help of some fellow members on this site. Basically the code saves an Outlook attachment to the folder I have specified based on the Sender and Subject combination. the code works after restarting Outlook 2010 and will perform as expected a couple times and then stops and throws the following error:

Run-time error '-2147352567 (80020009)':
Array index out of bounds.

When I Debug it highlights this line of code:

Att = myAttachments.Item(1).DisplayName


What have I done wrong or failed to include to prevent this error?
Thanks for looking.


Here is the full code:


Private WithEvents Items As Outlook.Items
Option Explicit

Private Sub Application_Startup()
Dim olApp As Outlook.Application
Dim objNS As Outlook.NameSpace
Set olApp = Outlook.Application
Set objNS = olApp.GetNamespace("MAPI")
Set Items = objNS.GetDefaultFolder(olFolderInbox).Items
End Sub
Private Sub Items_ItemAdd(ByVal Item As Object)

Dim Msg As Outlook.MailItem
Dim attPath As String
Dim Att As String
Dim strFullPath As String
Dim myAttachments As Attachments
Dim myAtt As Attachment
Dim olDestFldr As Outlook.MAPIFolder


On Error Goto ErrorHandler
'Only act if it's a MailItem

If TypeName(Item) = "MailItem" Then
Set Msg = Item
Set myAttachments = Item.Attachments
Att = myAttachments.Item(1).DisplayName
myAttachments.Item(1).SaveAsFile attPath & Att
If (Msg.Sender = "Sender, Joe") And _
(Msg.Subject = "My Report") And _
(Msg.Attachments.Count >= 1) Then
attPath = "G:\Daily Report\Reports\"
myAttachments.Item(1).SaveAsFile attPath & Att
Call Report_Unzip
Msg.UnRead = False
'Msg.Move olDestFldr

ElseIf (Msg.Sender = "Jane Sender") And _
(Msg.Subject = "Test Mail 2") And _
(Msg.Attachments.Count >= 1) Then
attPath = "I:\Mail\"
myAttachments.Item(1).SaveAsFile attPath & Att
Msg.UnRead = False
'Msg.Move olDestFldr

ElseIf (Msg.Sender = "Mail Subscriptions") And _
(Msg.Subject = "Test Mail 3") And _
(Msg.Attachments.Count >= 1) Then
attPath = "C:\Documents and Settings\myfolder name\My Documents\Test File\"
myAttachments.Item(1).SaveAsFile attPath & Att
Msg.UnRead = False
'Msg.Move olDestFldr


End If
End If
ProgramExit:
Exit Sub

ErrorHandler:
MsgBox Err.Number & " - " & Err.Description
Resume ProgramExit
End Sub

Sub TA_Unzip()
On Error Goto ErrorHandler
Dim appAccess As Object ' Access.Application
Dim objZip
Set objZip = CreateObject("XStandard.Zip")
objZip.UnPack "G:\Daily Report\Reports\Daily_Report.zip", "G:\Daily Report\Reports\"
Set objZip = Nothing
' Get a reference to the Access Application object.
Set appAccess = CreateObject("Access.Application")

' open TA database and build reports with timer pause to allow time to run
Dim tim As Long
appAccess.OpenCurrentDatabase ("G:\Daily Report\Reports\Report_db.accdb")
tim = Timer
Do While Timer < tim + 2
DoEvents
Loop

' hide the application.
appAccess.Visible = False
appAccess.DoCmd.RunMacro "Report Process"

' Close the database and quit Access
appAccess.CloseCurrentDatabase
appAccess.Quit

' Close the object variable.
Set appAccess = Nothing
ProgramExit:
Exit Sub

ErrorHandler:
MsgBox Err.Number & " - " & Err.Description
Resume ProgramExit
End Sub

telepicker
04-08-2011, 06:05 AM
Just add and else (not elseif) to the end of the if statement and either say exit sub or goto programexit

Thanks Brian