Reference subfolder of Inbox to move mail

Question

I have Outlook 2010. I get emails with the same subject line, with a PDF to open. When the PDF is open, Adobe asks if I want to add it to an Excel response file, and I say yes.

I'd like to have it respond with "Okay" when Adobe asks about adding to the response file, but I can manage without it. At this line:

Set SubFolder = Mailbox.Folders("Response File")

I am getting an error:

The attempted operation failed. An object could not be found.

The subfolder where the unread emails are is called "!Response File" (without quotes) underneath my Inbox. After having the PDF opened, I'd like to mark the email as read, and moved to another subfolder (under Inbox) called "Extracted" (without quotes).

Sub GetAttachments()
  On Error GoTo GetAttachments_err
  Dim ns As NameSpace
  Dim Inbox As MAPIFolder
  Dim SubFolder As MAPIFolder
  Dim Item As Object
  Dim Atmt As Attachment
  Dim FileName As String
  Dim i As Integer

  Set ns = GetNamespace("MAPI")
  Set Inbox = ns.GetDefaultFolder(olFolderInbox)
  Set Mailbox = Inbox.Parent
  Set SubFolder = Mailbox.Folders("!Response File")
  i = 0

  'check if there is any mail in the folder'
  If SubFolder.Items.Count = 0 Then
    MsgBox "There are no messages in the folder.", vbInformation, _
    "Nothing Found"
    Exit Sub
  End If

  'Check each message and save the attachment'
  If SubFolder.Items.Count > 0 Then
    For Each Item In SubFolder.Items
      If Item.UnRead = True Then
        For Each Atmt In Item.Attachments
          FileName = "C:\Users\abrupbac\Desktop\Response Emails\" & Atmt.FileName
          Atmt.SaveAsFile FileName 'saves each attachment'

          'this code opens each attachment'
          Set myShell = CreateObject("WScript.Shell")
          myShell.Run FileName

          'this sets the email as read'
          Item.UnRead = False
          'updates the counter'
          i = i + 1

        Next Atmt
      End If
    Next Item
  End If

  'Display results

  If i > 0 Then
    MsgBox "I found " & i & " attached files." _
     & vbCrLf & "They are saved on your desktop" _
     & vbCrLf & vbCrLf & "Have a nice day.", vbInformation, "Finished!"
  Else
    MsgBox "I didn't find any attached files in your mail.", vbInformation, _
     "Finished!"
 End If

'Replenish Memory'
GetAttachments_exit:

  Set Atmt = Nothing
  Set Item = Nothing
  Set ns = Nothing
  Exit Sub

  'function for sorting the excel attachment'

GetAttachments_err:
  MsgBox "An unexpected error has occurred." _
  & vbCrLf & "Please note and report the following information." _
  & vbCrLf & "Macro Name: GetAttachments" _
  & vbCrLf & "Error Number: " & Err.Number _
  & vbCrLf & "Error Description: " & Err.Description _
  , vbCritical, "Error!"
  Resume GetAttachments_exit
End Sub

Answer 1

welcome to StackOverflow!

To answer your specific question,

I get a "The attempted operation failed. An object could not be found." error at:
Set SubFolder = Mailbox.Folders("!Response File")

You get this error because "!Response File" is not within the parent of Inbox. It can be tricky to find a folder by name. You could instead access the folder by ID. One way to get the ID of a desired folder is to write a function to do so.

    Function GetInboxFolderID(FolderName As String) As String
    Dim nsp As Outlook.Folder
    Dim mpfSubFolder As Outlook.Folder
    Dim mpfSubFolder2 As Outlook.Folder
    Dim flds As Outlook.Folders
    Dim flds2 As Outlook.Folders

    Set nsp = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)
    Set flds = nsp.Folders
    Set mpfSubFolder = flds.GetFirst
    Do While Not mpfSubFolder Is Nothing
        If mpfSubFolder.Name = FolderName Then
            GetInboxFolderID = mpfSubFolder.EntryID
            Exit Function
        End If
        Set flds2 = mpfSubFolder.Folders
        Set mpfSubFolder2 = flds2.GetFirst
        Do While Not mpfSubFolder2 Is Nothing
            If mpfSubFolder2.Name = FolderName Then
                GetInboxFolderID = mpfSubFolder2.EntryID
                Exit Function
            End If
            Set mpfSubFolder2 = flds2.GetNext
        Loop
        Set mpfSubFolder = flds.GetNext
    Loop
End Function

Additionally, here is a code to test it.

Sub testing()
Dim tv As String
tv = GetInboxFolderID("Response File")
  Set myNewFolder = Application.Session.GetFolderFromID(tv)
 myNewFolder.Display

End Sub 

This function loops thorugh your main set of user folders, then checks each of these folders for the string given in folder name. If the function finds it, then it returns the ID to that folder.

The testing subroutine is just there for debugging purposes, and when you run it, it should open the folder you named in the function i.e "Response File"

Changing your line :

Set SubFolder = Mailbox.Folders("!Response File")

To:

Set SubFolder = Application.Session.GetFolderFromID(GetInboxFolderID("Response File"))

Should get you past your current bug, if you implement my function.

Additionally, you may be able to close the "Okay" message using SendKeys

Call AppActivate("Adobe Reader", True)
 DoEvents
 SendKeys "{Enter}"

Hope this helps!