0

I have several email addresses configured in Outlook. I would like to select a folder from one of those email addresses.

The code reads from the inbox of the main account. Would it be possible read from a specified email address?

Set outNs = outApp.GetNamespace("MAPI")
Set outFolder = outNs.GetDefaultFolder(olFolderInbox)

If Not outFolder Is Nothing Then
    For Each outItem In outFolder.Items
        If outItem.Class = Outlook.OlObjectClass.olMail Then
            Set outMailItem = outItem

            If InStr(1, outMailItem.Subject, subjectFilter) > 0 Then 'removed the quotes around subjectFilter

                For Each outAttachment In outMailItem.Attachments
                    If Dir(saveFolder, vbDirectory) = "" Then FSO.CreateFolder (saveFolder)
                    outAttachment.SaveAsFile saveFolder & " - " & outAttachment.fileName
                    Set outAttachment = Nothing
                Next

            End If
        End If
    Next
End If

I tried the following, but I get:

The object does not support this property or method

For Each objStore In Application.Session.Stores
    If objStore = "++++++@o+++++.com" Then
    
        Set outNs = outApp.GetNamespace("MAPI")
        Set outFolder = outNs.GetDefaultFolder(olFolderInbox)
    
        If Not outFolder Is Nothing Then
            For Each outItem In outFolder.Items
                If outItem.Class = Outlook.OlObjectClass.olMail Then
                    Set outMailItem = outItem
                        If InStr(1, outMailItem.Subject, subjectFilter) > 0 Then 'removed the quotes around subjectFilter
                            For Each outAttachment In outMailItem.Attachments
                            If Dir(saveFolder, vbDirectory) = "" Then FSO.CreateFolder (saveFolder)
                                outAttachment.SaveAsFile saveFolder & outAttachment.Filename
                            Set outAttachment = Nothing
                            Next
                        End If
                End If
            Next
        End If
    End If
Next

Finally the working code:

Set outNs = outApp.GetNamespace("MAPI")
Set outFolder = outNs.Folders("+++++++++++@+++++.com").Folders("Inbox") 'GetDefaultFolder(olFolderInbox)

If Not outFolder Is Nothing Then
    For Each outItem In outFolder.Items
        If outItem.Class = Outlook.OlObjectClass.olMail Then
            Set outMailItem = outItem
            If InStr(1, outMailItem.Subject, subjectFilter) > 0 Then 'removed the quotes around subjectFilter
                For Each outAttachment In outMailItem.Attachments
                    If Dir(saveFolder, vbDirectory) = "" Then FSO.CreateFolder (saveFolder)
                    outAttachment.SaveAsFile saveFolder & outAttachment.Filename
                    Set outAttachment = Nothing
                Next
            End If
        End If
    Next
End If
Community
  • 1
  • 1
  • Do you mean you want to access other `Account`'s inbox? If so then have you tried looping `Accounts` property in `outNS`? Once you located the account you can use `account.DeliveryStore.GetDefaultFolder(6)` to get the Inbox – Raymond Wu Aug 05 '21 at 09:54
  • I am trying to select a folder or the inbox of an account configured in Outlook. – Alejandro González Ponce Aug 05 '21 at 11:31
  • @RaymondWu I just tried modifying the code but it does not work. – Alejandro González Ponce Aug 05 '21 at 11:56
  • loop `outNS.Accounts` then check each `Account`'s `UserName` or `DisplayName` property, whichever you can use to identify. https://learn.microsoft.com/en-us/office/vba/api/outlook.namespace.accounts – Raymond Wu Aug 05 '21 at 11:59
  • Does this answer your question? [Get reference to additional Inbox](https://stackoverflow.com/questions/9076634/get-reference-to-additional-inbox) – niton Aug 05 '21 at 12:44
  • "Select" as in "show a dialog that lets the user browse through and select an Outlook folder"? – Dmitry Streblechenko Aug 05 '21 at 16:16

1 Answers1

0

First of all, I've noticed that you iterate over all items in a folder which is not really a good idea. Instead, you need to use the Find/FindNext or Restrict methods of the Items class to get items that corresponds to your conditions. Read more about these method in the following articles:

Also you can combine two conditions together into a single one. To find items with attachments you can use the following search criteria:

query ="@SQL=" & chr(34) & "urn:schemas:httpmail:hasattachment" & chr(34) & "=1"

To iterate over all stores in the profile you can use the Stores property which returns a Stores collection object that represents all the Store objects in the current profile. The Store.DisplayName property returns a string representing the display name of the Store object. For example:

Sub EnumerateFoldersInStores() 
 Dim colStores As Outlook.Stores
 Dim oStore As Outlook.Store 
 Dim oRoot As Outlook.Folder 
 
 On Error Resume Next 
 Set colStores = Application.Session.Stores
 For Each oStore In colStores 
   Set oRoot = oStore.GetRootFolder 
   Debug.Print (oRoot.FolderPath) 
   EnumerateFolders oRoot 
 Next 
End Sub 
 
Private Sub EnumerateFolders(ByVal oFolder As Outlook.Folder) 
 Dim folders As Outlook.folders 
 Dim Folder As Outlook.Folder 
 Dim foldercount As Integer 
 
 On Error Resume Next 
 
 Set folders = oFolder.folders 
 foldercount = folders.Count 
 'Check if there are any folders below oFolder 
 If foldercount Then 
   For Each Folder In folders 
     Debug.Print (Folder.FolderPath) 
     EnumerateFolders Folder 
   Next 
 End If 
End Sub
Eugene Astafiev
  • 47,483
  • 3
  • 24
  • 45
  • Good @Eugene, Thank you very much for your time and your answer, I will investigate to try to debug the code more, I am not an expert in programming and much less in VBA, that's why I throw code like crazy. – Alejandro González Ponce Aug 06 '21 at 06:49