Reference an Outlook folder from a cell.value-CodePudding

I have a macro to extract all the emails in a mailbox to an Excel sheet.

I need to add a line to specify the mailbox. This configuration remains fixed at the user level, since it is only possible to change the mailbox at the programming level.

The user has several shared mailboxes in their Outlook. They should select which mailbox to extract.

Sub ExtraerCorreosDeOutlook()

Dim OutlookApp As Object
Dim ONameSpace As Object
Dim MyFolder As Object
Dim OItem As Object
Dim Fila As Integer
Dim Mailbox As String

Set OutlookApp = CreateObject("Outlook.Application")
Set ONameSpace = OutlookApp.GetNamespace("MAPI")
Mailbox = Sheets(1).Range("A1").Value 'In this cell I select the mailbox.

Set MyFolder = ONameSpace.Folders(Mailbox).Folders(1)
'Set MyFolder = ONameSpace.Folders("[email protected]").Folders(1) 'If I use this line the macro works well, but the mailbox is fixed.

Range(Range("A2"), ActiveCell.SpecialCells(xlLastCell)).ClearContents

Fila = 2

For Each OItem In MyFolder.Items

    Sheets("Hoja1").Cells(Fila, 1).Value = OItem.SenderEmailAddress
    Sheets("Hoja1").Cells(Fila, 2).Value = OItem.To
    Sheets("Hoja1").Cells(Fila, 3).Value = OItem.Subject
    Sheets("Hoja1").Cells(Fila, 4).Value = OItem.ReceivedTime
    Sheets("Hoja1").Cells(Fila, 5).Value = OItem.Body

    Fila = Fila   1

Next OItem

Set OutlookApp = Nothing
Set ONameSpace = Nothing
Set MyFolder = Nothing

End Sub

I need to define the Mailbox variable using a cell value.

CodePudding user response：

Use Range.Text property (Excel) instead of value, also use Trim functions

for mailbox shared see example from Excel

Option Explicit
Public Sub Example()
    Dim olApp As Outlook.Application
    Dim olNS As Outlook.Namespace
    Dim Inbox As Outlook.MAPIFolder
    Dim Items As Outlook.Items
    Dim i As Long

    Dim Mailbox As String
    Mailbox = Trim(Sheets(1).Range("A1").Text)
    
    '// Ref to Outlook Inbox
    ' Make sure to set Microsoft Outlook Object XX.X in the Tools>Reference
    Set olApp = New Outlook.Application
    Set olNS = olApp.GetNamespace("MAPI")
    
    Dim Recip As Outlook.Recipient
    Set Recip = olNS.CreateRecipient(Mailbox)
        Recip.Resolve
        
    Set Inbox = olNS.GetSharedDefaultFolder(Recip, olFolderInbox)

    Set Items = Inbox.Items

    For i = Items.Count To 1 Step -1
        Debug.Print Items(i) '
'       do something with Items
    Next
End Sub

CodePudding user response：

The code depends whether a shared mailbox is visible and configured in the Outlook profile. If so, you could iterate over all mailboxes/stores using the NameSpace.Stores property which returns a Stores collection object that represents all the Store objects in the current profile.

A profile defines one or more email accounts, and each email account is associated with a server of a specific type. For an Exchange server, a store can be on the server, in an Exchange Public folder, or in a local Personal Folders File (.pst) or Offline Folder File (.ost). For a POP3, IMAP, or HTTP email server, a store is a .pst file.

Use the Stores and Store objects to enumerate all folders and search folders on all stores in the current session. Since getting the root folder or search folders in a store requires the store to be open and opening a store imposes an overhead on performance, you can check the Store.IsOpen property before you decide to pursue the operation.

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

If the account is not visible in Outlook (shared in Exchange) you may consider using the NameSpace.GetSharedDefaultFolder method which returns a Folder object that represents the specified default folder for the specified user. This method is used in a delegation scenario, where one user has delegated access to another user for one or more of their default folders (for example, their shared Inbox folder).

Sub ResolveName() 
 Dim myNamespace As Outlook.NameSpace 
 Dim myRecipient As Outlook.Recipient 
 Dim CalendarFolder As Outlook.Folder 
 
 Set myNamespace = Application.GetNamespace("MAPI") 
 Set myRecipient = myNamespace.CreateRecipient("Eugene Astafiev") 
 myRecipient.Resolve 
 
 If myRecipient.Resolved Then 
   Call ShowCalendar(myNamespace, myRecipient) 
 End If 
End Sub 
 
Sub ShowCalendar(myNamespace, myRecipient) 
 Dim CalendarFolder As Outlook.Folder 
 
 Set CalendarFolder = myNamespace.GetSharedDefaultFolder(myRecipient, olFolderCalendar) 
 CalendarFolder.Display 
End Sub

The NameSpace.OpenSharedFolder and NameSpace.OpenSharedItem methods can be considered as well.

CodePudding user response：

Thanks all. It was my mistake. As Eugene said in a comment the reference mailbox was wrong. I had writen wrong the email in the cell. Thanks community for your help and support.