title: Array Index out of bounds - VBA Outlook
body: <p>I'm running across an error </p>
  
  <blockquote>
    <p>Array Index out of bounds</p>
  </blockquote>
  
  <p>and not sure where to go from here as I've tried redefining the array. </p>
  
  <p>I'm getting the error on the line: <code>Set SubFolder = Inbox.Folders(folder)</code></p>
  
  <p>The error started to happen when I modified my code to also sort if the file had an attachment of not.</p>
  
  <p>This was the original sorting code: </p>
  
  <pre><code>If InStr(UCase(Message.Body), "OUT OF THE OFFICE") Or InStr(UCase(Message.Body), "OUT OF OFFICE") Then
      folder = "Ignore"
  ElseIf Message.Subject = "Secure Message Received" Then
      folder = "SecureMessageReceived"
  ElseIf response = "YES" Then
      folder = "No changes"
  ElseIf response = "NO" And newEmail &lt;&gt; "" Then
      folder = "ToBeLoaded"
  ElseIf response = "NO" And newEmail = "" Then
      folder = "ToBeReviewed"
  ElseIf response = "??" Then
      folder = "ToBeFixed"
  End If
  </code></pre>
  
  <p>It was changed to this tidbit:</p>
  
  <pre><code>    If response = "NO" And iAttachments = 1 Then
          If newEmail &lt;&gt; "" Then
              folder = "ToBeLoaded"
          ElseIf newEmail = "" Then
              folder = "ToBeWorked"
          End If
      ElseIf response = "NO" And iAttachments = 0 Then
          If newEmail &lt;&gt; "" Then
              folder = "ToBeReviewed"
          ElseIf newEmail = "" Then
              folder = "ToBeReviewed"
          End If
      End If
  
      If InStr(UCase(Message.Body), "OUT OF THE OFFICE") Or InStr(UCase(Message.Body), "OUT OF OFFICE") Then
          folder = "Ignore"
      ElseIf Message.Subject = "Secure Message Received" Then
          folder = "SecureMessages"
      End If
  </code></pre>
  
  <p>The code will error here:</p>
  
  <pre><code>  Set SubFolder = inbox.Folders(folder)
  </code></pre>
  
  <p>And give me the 440 Array Index Out of Bounds error.</p>
  
  <p>The FULL code for reference:</p>
  
  <pre><code>Dim objXLApp
  Dim myRegExp
  
  Function GetInbox(MailboxName As String)
  
  Dim objOutlook As Object, objnSpace As Object, objFolder As MAPIFolder
  
  Dim InboxFolder As folder
  Dim MainFolder As folder
  Dim SubFolder As folder
  
  
  For Each MainFolder In Session.Folders
      If MainFolder.name = MailboxName Then
          For Each SubFolder In MainFolder.Folders
              If SubFolder.name = "Inbox" Then
                  Set InboxFolder = SubFolder
              End If
          Next
      End If
  Next
  
  Set GetInbox = InboxFolder 'objFolder
  End Function
  
  Public Sub ProcessAll_test()
  Dim InboxFolder As folder
  Dim Message
  Dim MailboxName As String
  Dim i
  Set myRegExp = New RegExp
  myRegExp.IgnoreCase = True
  myRegExp.Global = True
  myRegExp.Pattern = "[a-z0-9\.\-\_]+\@[a-z0-9\.\-]+\.[a-z]+"
  
  MailboxName = "test"
  Set InboxFolder = GetInbox(MailboxName)
  If Not InboxFolder Is Nothing Then
      Set emailList = CreateObject("System.Collections.ArrayList")
      'For Each Message In InboxFolder.Items
      For i = InboxFolder.Items.Count To 1 Step -1 'Iterates from the end backwards
          Set Message = InboxFolder.Items(i)
          If TypeName(Message) = "MailItem" Then
              ProcessOne Message, InboxFolder
          End If
      Next
  End If
  
  End Sub
  
  Public Sub ProcessOne(Message, inbox)
  Dim Pos, id, vals, name, email, response, attachment
  Dim i
  'Dim oMail As Object
  Dim iAttachments As Integer
  
  'Dim inbox As Object
  'Set attachment = Application.CreateItem(olMailItem)
  Pos = InStr(Message.Body, "place X here:")
  
  If Len(Message.Subject) &gt; 0 Then
      vals = Split(Message.Subject, " ")
      id = vals(UBound(vals))
  Else
      id = "No_Subject"
  End If
  
  name = Message.Sender.name
  email = Message.Sender.Address
  response = ""
  newEmail = ""
  RecDate = Message.ReceivedTime
  
  'inbox = Folders("testfolder").Folders("Inbox")
  
  
  If Pos &gt; 0 Then
      x = UCase(Mid(Message.Body, Pos + 23, 20))
      Pos = InStr(x, "X")
      If Pos &gt; 0 Then
          response = "YES"
      Else
          Pos = 1
          Do While Pos &lt;&gt; 0
              Pos = InStr(Pos + 1, Message.Body, "@")
              If Pos &lt;&gt; 0 Then
                  posA = InStrRev(Message.Body, " ", Pos)
                  posB = InStr(Pos, Message.Body, " ")
                  emailSection = Mid(Message.Body, posA + 1, posB - posA - 1)
                  anotherEmail = ""
                  Set myMatches = myRegExp.Execute(emailSection)
                  For Each myMatch In myMatches
                    anotherEmail = myMatch.Value
                  Next
                  If anotherEmail &lt;&gt; "test@test.com" Then
                      newEmail = anotherEmail
                  End If
              End If
          Loop
          response = "NO"
      End If
  Else
      response = "??"
  End If
  
  'Move email items
  iAttachments = attachmentscount
  'For i = iAttachments - 1 To 1 Step -1
  'For i = 0 To iAttachments - 1
  'If iAttachments = olMail Then
      If response = "NO" And iAttachments = 1 Then
          If newEmail &lt;&gt; "" Then
              folder = "ToBeLoaded"
          ElseIf newEmail = "" Then
              folder = "ToBeWorked"
          End If
      ElseIf response = "NO" And iAttachments = 0 Then
          If newEmail &lt;&gt; "" Then
              folder = "ToBeReviewed"
          ElseIf newEmail = "" Then
              folder = "ToBeReviewed"
          End If
      End If
  
      If InStr(UCase(Message.Body), "OUT OF THE OFFICE") Or InStr(UCase(Message.Body), "OUT OF OFFICE") Then
          folder = "Ignore"
      ElseIf Message.Subject = "Secure Message Received" Then
          folder = "SecureMessages"
      End If
  
  WriteFile id, name, email, response, newEmail, RecDate, folder
  Set SubFolder = inbox.Folders(folder)
  'Next i
  
  Message.UnRead = True
  Message.Move SubFolder
  
  
  End Sub
  
  Sub WriteFile(id, name, email, response, newEmail, RecDate, folder)
  
  Set WshShell = CreateObject("WScript.Shell")
  Set fso = CreateObject("Scripting.FileSystemObject")
  FileName = fso.BuildPath(WshShell.SpecialFolders("Desktop"), "test_" &amp; Format(Date, "MMddyyyy") &amp; ".xls")
  
  Dim Content As String
  ' Create an excel object if there is not one already.
  If objXLApp = Empty Then
      Set objXLApp = CreateObject("Excel.Application")
  End If
  
  ' Create or open existing file.
  objXLApp.DisplayAlerts = False
  If fso.FileExists(FileName) Then
      Set objXLWb = objXLApp.Workbooks.Open(FileName)
  Else
      Set objXLWb = objXLApp.Workbooks.Add()
  End If
  Set objXLWs = objXLWb.Worksheets(1)
  
  ' Add one row to the excel.
  With objXLWs
      CurrentRow = 2
      While .Cells(CurrentRow, 2).Value &lt;&gt; ""
          CurrentRow = CurrentRow + 1
      Wend
      .Cells(1, 1).Value = "ID"
      .Cells(1, 2).Value = "Name"
      .Cells(1, 3).Value = "Email"
      .Cells(1, 4).Value = "Response"
      .Cells(1, 5).Value = "New Email"
      .Cells(1, 6).Value = "RecDate"
      .Cells(1, 7).Value = "Folder"
  
      .Cells(CurrentRow, 1).Value = id
      .Cells(CurrentRow, 2).Value = name
      .Cells(CurrentRow, 3).Value = email
      .Cells(CurrentRow, 4).Value = response
      .Cells(CurrentRow, 5).Value = newEmail
      .Cells(CurrentRow, 6).Value = RecDate
      .Cells(CurrentRow, 7).Value = folder
  End With
  
  objXLWb.SaveAs FileName, True
  objXLWb.Close
  End Sub
  </code></pre>
  
  <hr>
  
  <p>In particular, I will get the error at this section of the code:</p>
  
  <pre><code>iAttachments = attachmentscount
  'For i = iAttachments - 1 To 1 Step -1
  'For i = 0 To iAttachments - 1
  'If iAttachments = olMail Then
      If response = "NO" And iAttachments = 1 Then
          If newEmail &lt;&gt; "" Then
              folder = "ToBeLoaded"
          ElseIf newEmail = "" Then
              folder = "ToBeWorked"
          End If
      ElseIf response = "NO" And iAttachments = 0 Then
          If newEmail &lt;&gt; "" Then
              folder = "ToBeReviewed"
          ElseIf newEmail = "" Then
              folder = "ToBeReviewed"
          End If
      End If
  
      If InStr(UCase(Message.Body), "OUT OF THE OFFICE") Or InStr(UCase(Message.Body), "OUT OF OFFICE") Then
          folder = "Ignore"
      ElseIf Message.Subject = "Secure Message Received" Then
          folder = "SecureMessages"
      End If
  
  WriteFile id, name, email, response, newEmail, RecDate, folder
  Set SubFolder = inbox.Folders(folder)
  'Next i
  
  Message.UnRead = True
  Message.Move SubFolder
  
  
  End Sub
  </code></pre>