'An object cannot be found' when accessing Outlook folders.

Good day! I am reasonably proficient in Excel VBA programming, but completely new to the Outlook object model. I have tried and failed (at the first hurdle) to install a useful batch-printing macro which I found on the VBA Express website: it shouldprint any PDF attachments found in the "Batch Prints" subfolder of the "Inbox" folder. Attempting to get things going results in 'An object cannot be found' in the highlighted line of code. Can you help at all, please? I am using version 14.0.6112.5000 (32-bit). Ps. "Batch Prints" folder DEFINITELY exists and is a subfolder of "Inbox"

Code:

---

'###############################################################################
 '### Module level Declarations
 'expose the items in the target folder to events
Option Explicit
Dim WithEvents TargetFolderItems As Items
 'set the string constant for the path to save attachments
Const FILE_PATH As String = "C:\Temp\"
 
 '###############################################################################
 '### this is the Application_Startup event code in the ThisOutlookSession module
Private Sub Application_Startup()
    'some startup code to set our "event-sensitive" items collection
    Dim ns As Outlook.NameSpace
    '
    Set ns = Application.GetNamespace("MAPI")
    ****** Set TargetFolderItems = ns.Folders.Item("Inbox").Folders.Item("Batch Prints").Items  *******  <- PROBLEM HERE
   
End Sub
 
 '###############################################################################
 '### this is the ItemAdd event code
Sub TargetFolderItems_ItemAdd(ByVal Item As Object)
    'when a new item is added to our "watched folder" we can process it
    Dim olAtt As Attachment
    Dim i As Integer
   
    If Item.Attachments.Count > 0 Then
        For i = 1 To Item.Attachments.Count
            Set olAtt = Item.Attachments(i)
            'save the attachment
            olAtt.SaveAsFile FILE_PATH & olAtt.FileName
           
            'if its an Excel file, pass the filepath to the print routine
            If UCase(Right(olAtt.FileName, 3)) = "PDF" Then
                PrintAtt (FILE_PATH & olAtt.FileName)
            End If
        Next
    End If
   
    Set olAtt = Nothing
   
End Sub
 
 '###############################################################################
 '### this is the Application_Quit event code in the ThisOutlookSession module
Private Sub Application_Quit()
   
    Dim ns As Outlook.NameSpace
    Set TargetFolderItems = Nothing
    Set ns = Nothing
   
End Sub
 
 '###############################################################################
 '### print routine
Sub PrintAtt(fFullPath As String)
   
    Dim xlApp As Excel.Application
    Dim wb As Excel.Workbook
   
    'in the background, create an instance of xl then open, print, quit
    Set xlApp = New Excel.Application
    Set wb = xlApp.Workbooks.Open(fFullPath)
    wb.PrintOut
    xlApp.Quit
   
    'tidy up
    Set wb = Nothing
    Set xlApp = Nothing
   
End Sub

---

If the folder is a sub folder of the DEFAULT inbox then

Code:

---

Set TargetFolderItems = ns.GetDefaultFolder(olFolderInbox).folders("Batch Prints").Items

---

If you have multiple accounts and inboxes then if the above is not appropriate, cycle through the available accounts e.g.

Code:

---

Dim olNS As Outlook.NameSpace
Dim olStore As Outlook.Store
Dim olFolder As Outlook.Folder
    Set olNS = Application.GetNamespace("Mapi")
    For Each olStore In olNS.Stores
        For Each olFolder In olStore.GetDefaultFolder(olFolderInbox).folders
            If olFolder.Name = "Batch Prints" Then
                MsgBox "Folder exists in store " & olStore.DisplayName
                'do something with olFolder
                Exit For
            End If
        Next olFolder
    Next olStore

---

Thanks very much, that's very helpful! It worked.... until I hit this line:

Dim xlApp As Excel.Application

The application WAS designed to print out .XLS attachments. I realise now that I have to do more than change .XLS to .PDF How could I get it to print out a PDF using VBA? I have Adobe Acrobat XI installed.

Thanks so much for your interest in this post.

As you appear to have realised Excel cannot open and print PDFs. Rather than try and debug the posted code, I have posted an alternative that should work. All the code goes in a standard module and not ThisOutlookSession. (The declaration section will need modifying for 64 bit Office).

The code includes a macro that will enable you to test with a selected message with PDF attachment.

There is also a macro to process a folder. That macro has code for using a progress bar userform commented out. If you want to use the progress bar, you can download it from http://www.gmayor.com/Zips/ProgressBar.zip

The code uses the Shell function to print to the associated application. If you want to program Acrobat directly then Diane Poremsky has it covered at http://www.poremsky.com/office/print-pdf-vba/

Code:

---

Option Explicit
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _
                                      (ByVal hwnd As Long, _
                                      ByVal lpOperation As String, _
                                      ByVal lpFile As String, _
                                      ByVal lpParameters As String, _
                                      ByVal lpDirectory As String, _
                                      ByVal nShowCmd As Long) As Long

Sub ProcessSelectedMessage()
Dim olMsg As MailItem
    On Error Resume Next
    Set olMsg = ActiveExplorer.Selection.Item(1)
    PrintAttachments olMsg
lbl_Exit:
    Exit Sub
End Sub

Sub ProcessFolder()
Dim olNs As Outlook.NameSpace
Dim olMailFolder As Outlook.MAPIFolder
Dim olItems As Outlook.Items
Dim olMailItem As Outlook.MailItem
'Dim oFrm As New frmProgress
'Dim PortionDone As Double
Dim i As Long

    On Error GoTo err_Handler
    Set olNs = GetNamespace("MAPI")
    Set olMailFolder = olNs.PickFolder
    Set olItems = olMailFolder.Items
    'oFrm.Show vbModeless
    i = 0
    For Each olMailItem In olItems
        i = i + 1
'        PortionDone = i / olItems.Count
'        oFrm.lblProgress.Width = oFrm.fmeProgress.Width * PortionDone
        PrintAttachments olMailItem
        DoEvents
    Next olMailItem
err_Handler:
    'Unload oFrm
    'Set oFrm = Nothing
    Set olNs = Nothing
    Set olMailFolder = Nothing
    Set olItems = Nothing
    Set olMailItem = Nothing
lbl_Exit:
    Exit Sub
End Sub


Private Sub PrintAttachments(olItem As MailItem)
Dim olAttach As Attachment
Dim strFname As String
Dim strExt As String
Const strSaveFldr As String = "C:\Temp\"

    CreateFolders strSaveFldr
    On Error GoTo CleanUp
    If olItem.Attachments.Count > 0 Then
        For Each olAttach In olItem.Attachments
            If LCase(olAttach.FileName) Like "*.pdf" Then
                strFname = olAttach.FileName
                strExt = Right(strFname, Len(strFname) - InStrRev(strFname, Chr(46)))
                strFname = FileNameUnique(strSaveFldr, strFname, strExt)
                olAttach.SaveAsFile strSaveFldr & strFname
                PrintFile 0, strSaveFldr & strFname
            End If
        Next olAttach
    End If
CleanUp:
    Set olAttach = Nothing
    Set olItem = Nothing
lbl_Exit:
    Exit Sub
End Sub

Private Function FileNameUnique(strPath As String, _
                              strFileName As String, _
                              strExtension As String) As String
Dim lngF As Long
Dim lngName As Long
    lngF = 1
    lngName = Len(strFileName) - (Len(strExtension) + 1)
    strFileName = Left(strFileName, lngName)
    Do While FileExists(strPath & strFileName & Chr(46) & strExtension) = True
        strFileName = Left(strFileName, lngName) & "(" & lngF & ")"
        lngF = lngF + 1
    Loop
    FileNameUnique = strFileName & Chr(46) & strExtension
lbl_Exit:
    Exit Function
End Function

Private Function FileExists(filespec) As Boolean
Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    If fso.FileExists(filespec) Then
        FileExists = True
    Else
        FileExists = False
    End If
lbl_Exit:
    Exit Function
End Function

Private Function FolderExists(fldr) As Boolean
  Dim fso As Object
  Set fso = CreateObject("Scripting.FileSystemObject")
  If (fso.FolderExists(fldr)) Then
      FolderExists = True
  Else
      FolderExists = False
  End If
lbl_Exit:
    Exit Function
End Function

Private Function CreateFolders(strPath As String)
Dim strTempPath As String
Dim lngPath As Long
Dim vPath As Variant
    vPath = Split(strPath, "\")
    strPath = vPath(0) & "\"
    For lngPath = 1 To UBound(vPath)
        strPath = strPath & vPath(lngPath) & "\"
        If Not FolderExists(strPath) Then MkDir strPath
    Next lngPath
lbl_Exit:
    Exit Function
End Function

Private Function PrintFile(lngForm As Long, strFileName As String)
Dim retVal As Long
    On Error Resume Next
    retVal = ShellExecute(lngForm, "Print", strFileName, 0&, 0&, 3)
lbl_Exit:
    Exit Function
End Function

---

Wow! A whole new world of possibilities is opening up. Thanks very much. I will try it this morning.