CODEWITHSUNDEEP
vbaoutlook
CJ Robis
CJ Robis

Reputation: 95

Shared Inbox Subfolder not visible within VBA

I have a routine that worked a few days ago but is hanging up now on Set SubFolder = oInbox.Folders("ProcessedForms").

The inbox has 0 (zero) folders when checked in the Immediate Pane during execution. ?oInbox.Folders.Count.

I checked Office 365 online and the Outlook App on my computer and there is a subfolder called 'ProcessedForms'.

Here is the full code:

Private Sub ScrapeOutlook(fileName As String, subject As String)
    Dim intFileNum As Integer
    Dim SubFolder As Outlook.MAPIFolder
    
    On Error GoTo ScrapeOutlookErr
    
    'Get the inbox from Outlook
    Set oApp = New Outlook.Application
    Set NS = oApp.Session
    Set objOwner = NS.CreateRecipient("[email protected]")
    objOwner.Resolve

    If objOwner.Resolved Then
        Set oInbox = NS.GetSharedDefaultFolder(objOwner, olFolderInbox)
        Set Application.ActiveExplorer.CurrentFolder = oInbox
    End If
    
    If Not TESTING Then Set SubFolder = oInbox.Folders("ProcessedForms")
    
    'Filter the items from the inbox based on the sender
    Set oRestrictItems = oInbox.Items.Restrict("[Subject] = '" & subject & "'")

    intFileNum = FreeFile
    Open fileName For Output As intFileNum
    itemsScraped = 0
    For Each oLatestItem In oRestrictItems
        Print #intFileNum, Replace( _
                            Replace( _
                             Replace( _
                              Replace( _
                               Replace(oLatestItem.Body, ",", "%") _
                              , vbNewLine, ",") _
                             , vbTab, ",") _
                            , ", ,Sent from Mycompany <https://mycompany.com>  ,", "") _
                           , ", ,", ",") & ",Time," & oLatestItem.SentOn
        If Not TESTING Then oLatestItem.UnRead = False
        'If Not TESTING Then oLatestItem.Move SubFolder
        itemsScraped = itemsScraped + 1
    Next oLatestItem
    Close #intFileNum
    
    
ScrapeOutlookExit:
    Exit Sub
    
ScrapeOutlookErr:
    HandleError "NewCustomers.ScrapeOutlook()"
    Resume ScrapeOutlookExit
    Resume
    
End Sub

Upvotes: 1

Views: 891

Answers (2)

niton
niton

Reputation: 9179

With the folders visible in the navigation pane you can try:

Option Explicit ' Consider this mandatory
' Tools | Options | Editor tab
' Require Variable Declaration
' If desperate declare as Variant


Private Sub ScrapeOutlook(fileName As String, subject As String)

    Dim mailBox As Folder
    Dim oInbox As Folder
    Dim subFolder As Folder
    
    'No error handling during debugging.
    
    Set mailBox = Session.Folders("[email protected]")
    Set oInbox = mailBox.Folders("Inbox")
        
    Debug.Print oInbox.Folders.count
    
    If oInbox.Folders.count > 0 Then
        Set subFolder = oInbox.Folders("ProcessedForms")
        Set ActiveExplorer.CurrentFolder = subFolder
    Else
        Debug.Print "No subfolders found."
    End If
    
End Sub


Private Sub test_ScrapeOutlook()
    ScrapeOutlook "dummyFilename", "dummySubject"
End Sub

Upvotes: 1

Dmitry Streblechenko
Dmitry Streblechenko

Reputation: 66215

GetSharedDefaultFolder for a folder cached in the primary mailbox's OST file contains no subfolders. Either uncheck "Download shared folders" checkbox in the Exchange account properties or open the parent mailbox as a delegate mailbox in the profile so that all folders are available and visible in Outlook.

Upvotes: 2

Related Questions