Solved: Array index out of bounds HELP!
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:
[vba]
Att = myAttachments.Item(1).DisplayName
[/vba]
What have I done wrong or failed to include to prevent this error?
Thanks for looking.
Here is the full code:
[vba]
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
[/vba]
